Safe Haskell | None |
---|---|
Language | Haskell2010 |
Indigo.Internal.State
Contents
Description
This module contains the core of Indigo language:
the IndigoState
monad, a datatype that represents its state.
It also includes some convenient functions to work with the state in IndigoM,
to provide rebindable syntax.
The IndigoState
monad implements the functionality of a symbolic interpreter.
During its execution Lorentz code is being generated.
Synopsis
- newtype IndigoState inp out a = IndigoState {
- runIndigoState :: MetaData inp -> GenCode inp out a
- usingIndigoState :: MetaData inp -> IndigoState inp out a -> GenCode inp out a
- (>>=) :: forall inp out out1 a b. IndigoState inp out a -> (a -> IndigoState out out1 b) -> IndigoState inp out1 b
- (=<<) :: (a -> IndigoState out out1 b) -> IndigoState inp out a -> IndigoState inp out1 b
- (>>) :: IndigoState inp out a -> IndigoState out out1 b -> IndigoState inp out1 b
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- return :: a -> IndigoState inp inp a
- iget :: IndigoState inp inp (MetaData inp)
- iput :: GenCode inp out a -> IndigoState inp out a
- data RefId
- data StkEl a where
- NoRef :: KnownValue a => StkEl a
- Ref :: KnownValue a => RefId -> StkEl a
- type StackVars (stk :: [Type]) = Rec StkEl stk
- data GenCode inp out a = GenCode {}
- data MetaData stk = MetaData {
- mdStack :: StackVars stk
- mdRefCount :: RefId
- emptyMetadata :: MetaData '[]
- cleanGenCode :: GenCode inp out a -> inp :-> inp
- type DefaultStack stk = Default (MetaData stk)
Indigo State
newtype IndigoState inp out a Source #
IndigoState monad. It's basically Control.Monad.Indexed.State , however this package is not in the used lts and it doesn't compile.
It takes as input a MetaData
(for the initial state) and returns a
GenCode
(for the resulting state and the generated Lorentz code).
IndigoState has to be used to write backend typed Lorentz code from the corresponding frontend constructions.
Constructors
IndigoState | |
Fields
|
Instances
Functor (IndigoState inp out) Source # | |
Defined in Indigo.Internal.State Methods fmap :: (a -> b) -> IndigoState inp out a -> IndigoState inp out b # (<$) :: a -> IndigoState inp out b -> IndigoState inp out a # |
usingIndigoState :: MetaData inp -> IndigoState inp out a -> GenCode inp out a Source #
(>>=) :: forall inp out out1 a b. IndigoState inp out a -> (a -> IndigoState out out1 b) -> IndigoState inp out1 b Source #
Bind for rebindable syntax.
It's basically like the bind for the State
monad, but it also composes the
generated code from m a
and a -> m b
.
(=<<) :: (a -> IndigoState out out1 b) -> IndigoState inp out a -> IndigoState inp out1 b Source #
(>>) :: IndigoState inp out a -> IndigoState out out1 b -> IndigoState inp out1 b Source #
Then for rebindable syntax.
(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #
An infix synonym for fmap
.
The name of this operator is an allusion to $
.
Note the similarities between their types:
($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b
Whereas $
is function application, <$>
is function
application lifted over a Functor
.
Examples
Convert from a
to a Maybe
Int
using Maybe
String
show
:
>>>
show <$> Nothing
Nothing>>>
show <$> Just 3
Just "3"
Convert from an
to an
Either
Int
Int
Either
Int
String
using show
:
>>>
show <$> Left 17
Left 17>>>
show <$> Right 17
Right "17"
Double each element of a list:
>>>
(*2) <$> [1,2,3]
[2,4,6]
Apply even
to the second element of a pair:
>>>
even <$> (2,2)
(2,True)
return :: a -> IndigoState inp inp a Source #
Return for rebindable syntax.
Reference id to a stack cell
Stack element of the symbolic interpreter.
It holds either a reference index that refers to this element
or just NoRef
, indicating that there are no references
to this element.
Constructors
NoRef :: KnownValue a => StkEl a | |
Ref :: KnownValue a => RefId -> StkEl a |
Instances
TestEquality StkEl Source # | |
Defined in Indigo.Internal.State |
Initial state of IndigoState
.
Constructors
MetaData | |
Fields
|
emptyMetadata :: MetaData '[] Source #
cleanGenCode :: GenCode inp out a -> inp :-> inp Source #
Produces the generated Lorentz code that cleans after itself, leaving the same stack as the input one
type DefaultStack stk = Default (MetaData stk) Source #