| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Alga.Language
- type SyntaxTree = [Sel]
- data Sel
- data Statement
- type Principle = [Element NRatio]
- type NRatio = Ratio Natural
- data Element a
- data AlgaEnv m a
- class Monad m => HasEnv m where
- runAlgaEnv :: Monad m => AlgaEnv m a -> m a
- addDef :: HasEnv m => String -> SyntaxTree -> m ()
- remDef :: HasEnv m => String -> m ()
- clearDefs :: HasEnv m => m ()
- getPrin :: HasEnv m => String -> m SyntaxTree
- getSrc :: HasEnv m => String -> m Text
- fullSrc :: HasEnv m => m Text
- getRefs :: HasEnv m => m [String]
- purgeEnv :: HasEnv m => [String] -> m ()
- checkRecur :: HasEnv m => String -> SyntaxTree -> m Bool
- evalDef :: HasEnv m => String -> m [NRatio]
- eval :: HasEnv m => SyntaxTree -> m [NRatio]
- toPrin :: HasEnv m => SyntaxTree -> m Principle
Documentation
type SyntaxTree = [Sel] Source #
Syntax tree in our case is just a collection of syntactic elements.
Syntactic element corresponds to language tokens. Some of them have
corresponding constructor in Element, others have
to be simplified first.
Constructors
| Value NRatio | Literal value |
| Section [Sel] | Section |
| Multi [Sel] | Multivalue |
| CMulti (NonEmpty ([Sel], [Sel])) | Conditional multivalue |
| Reference String | Reference (name of variable) |
| Range NRatio NRatio | Range of values |
| Product Sel Sel | Product of principles |
| Division Sel Sel | Division of principles |
| Sum Sel Sel | Sum of principles |
| Diff Sel Sel | Subtraction of principles |
| Loop Sel Sel | Loop |
| Rotation Sel Sel | Rotation |
| Reverse Sel | Reversed principle |
Statement can be either definition or exposition. Expositions are only used in REPL.
Constructors
| Definition String SyntaxTree | |
| Exposition SyntaxTree |
type Principle = [Element NRatio] Source #
Collection of elements for evaluation, representation of some aspect of voice.
type NRatio = Ratio Natural Source #
Non-negative rational number is the best choice for our purposes, hence the synonym.
Fundamental type representing an atom for evaluation.
Monad that implements ALGA environment.
Instances
| Monad m => Monad (AlgaEnv m) Source # | |
| Functor m => Functor (AlgaEnv m) Source # | |
| Monad m => Applicative (AlgaEnv m) Source # | |
| MonadIO m => MonadIO (AlgaEnv m) Source # | |
| MonadThrow m => MonadThrow (AlgaEnv m) Source # | |
| MonadCatch m => MonadCatch (AlgaEnv m) Source # | |
| MonadMask m => MonadMask (AlgaEnv m) Source # | |
| MonadException m => MonadException (AlgaEnv m) Source # | |
| Monad m => HasEnv (AlgaEnv m) Source # | |
class Monad m => HasEnv m where Source #
Type class for things that can be considered ALGA environment.
Minimal complete definition
runAlgaEnv :: Monad m => AlgaEnv m a -> m a Source #
Run state monad with ALGA environment.
Arguments
| :: HasEnv m | |
| => String | Reference name |
| -> SyntaxTree | AST of its principle |
| -> m () |
Add a new definition to the environment.
Remove definition given its name.
clearDefs :: HasEnv m => m () Source #
Remove all definitions, restoring default state of environment.
Arguments
| :: HasEnv m | |
| => String | Reference name |
| -> m SyntaxTree | Syntax tree |
Get principle corresponding to given variable name.
Get source code of definition given its name.
Purge environment removing definitions that are not used in construction of “top-level” definitions.
Arguments
| :: HasEnv m | |
| => String | Reference name |
| -> SyntaxTree | Its syntax tree |
| -> m Bool |
Check if definition with given name is depends on itself.
Evaluate definition given its name.
Arguments
| :: HasEnv m | |
| => SyntaxTree | Syntax tree |
| -> m [NRatio] | Infinite stream of ratios or empty list |
Evaluate given syntax tree.
Arguments
| :: HasEnv m | |
| => SyntaxTree | Syntax tree to transform |
| -> m Principle | Resulting principle |
Transform SyntaxTree into Principle applying all necessary
transformations and resolving references.