Copyright | (c) 2015 Chris Hodapp |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
- addAction :: (Schedule -> Schedule) -> Ion a -> Ion a
- getSched :: Ion Schedule
- getPhase :: Ion Integer
- ion :: String -> Ion a -> Ion a
- phaseSet :: Integral i => i -> Schedule -> Schedule
- delay :: Integral i => i -> Ion a -> Ion a
- phase :: Integral i => i -> Ion a -> Ion a
- period :: Integral i => i -> Ion a -> Ion a
- subPeriod :: Integral i => i -> Ion a -> Ion a
- disable :: Ion a -> Ion ()
- cond :: IvoryAction IBool -> Ion a -> Ion a
- ivoryEff :: IvoryAction () -> Ion ()
- newName :: Ion String
- area' :: (IvoryArea area, IvoryZero area) => String -> Maybe (Init area) -> Ion (Ref Global area)
- areaP' :: (IvoryArea area, IvoryZero area) => Proxy area -> String -> Maybe (Init area) -> Ion (Ref Global area)
- newArea :: (IvoryArea area, IvoryZero area) => Maybe (Init area) -> Ion (Ref Global area)
- newAreaP :: (IvoryArea area, IvoryZero area) => Proxy area -> Maybe (Init area) -> Ion (Ref Global area)
- newProc :: IvoryProcDef proc impl => impl -> Ion (Def proc)
- newProcP :: IvoryProcDef proc impl => Proxy (Def proc) -> impl -> Ion (Def proc)
- adapt_0_1 :: (IvoryType a, IvoryVar a) => Def (`[]` :-> ()) -> Ion (Def (`[a]` :-> ()))
- adapt_1_0 :: (Num a, IvoryType a, IvoryVar a) => Def (`[a]` :-> ()) -> Ion (Def (`[]` :-> ()))
- adapt_0_2 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b) => Def (`[]` :-> ()) -> Ion (Def (`[a, b]` :-> ()))
- adapt_2_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b) => Def (`[a, b]` :-> ()) -> Ion (Def (`[]` :-> ()))
- adapt_0_3 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c]` :-> ()))
- adapt_3_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b, Num c, IvoryType c, IvoryVar c) => Def (`[a, b, c]` :-> ()) -> Ion (Def (`[]` :-> ()))
- adapt_0_4 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c, IvoryType d, IvoryVar d) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c, d]` :-> ()))
- adapt_4_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b, Num c, IvoryType c, IvoryVar c, Num d, IvoryType d, IvoryVar d) => Def (`[a, b, c, d]` :-> ()) -> Ion (Def (`[]` :-> ()))
- adapt_0_5 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c, IvoryType d, IvoryVar d, IvoryType e, IvoryVar e) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c, d, e]` :-> ()))
- timer :: (a ~ Stored t, Num t, IvoryStore t, IvoryInit t, IvoryEq t, IvoryOrd t, IvoryArea a, IvoryZero a) => Proxy t -> Def (`[]` :-> ()) -> Ion (Ref Global (Stored t))
- startTimer :: (Num t, IvoryStore t, IvoryZeroVal t) => Ref Global (Stored t) -> Integer -> Ivory eff ()
- stopTimer :: (Num t, IvoryStore t, IvoryZeroVal t) => Ref Global (Stored * t) -> Ivory eff ()
Documentation
addAction :: (Schedule -> Schedule) -> Ion a -> Ion a Source
Transform a sub-node according to a function which transforms
Schedule
items, and then collect the state from it.
Specify a name of a sub-node, returning the parent. This node name is used in the paths to the node and in some C identifiers in the generated C code; its purpose is mainly diagnostic and to help the C code be more comprehensible.
Specify a minimum phase for a sub-node - that is, the earliest tick within a period that the sub-node should be scheduled at. Phase must be non-negative, and lower than the period.
Specify a period for a sub-node - that is, the interval, in ticks, at which the sub-node is scheduled to repeat. Period must be positive; a period of 1 indicates that the sub-node executes at every single clock tick.
Specify a sub-period for a sub-node - that is, the factor by which to multiply the inherited period. A factor of 2, for instance, would execute the sub-node half as often as its parent.
disable :: Ion a -> Ion () Source
Ignore a sub-node completely. This is intended to mask off some
part of a spec while still leaving it present for compilation.
Note that this disables only the scheduled effects of a node, and
so it has no effect on things like newProc
.
cond :: IvoryAction IBool -> Ion a -> Ion a Source
Make a sub-node's execution conditional; if the given Ivory effect
returns true
(as evaluated at the inherited phase and period),
then this sub-node is active, and otherwise is not. Multiple
conditions may accumulate, in which case they combine with a
logical and
(i.e. all of them must be true for the node to be active).
ivoryEff :: IvoryAction () -> Ion () Source
Attach an Ivory effect to an Ion
. This effect will execute at
the inherited phase and period of the node.
:: (IvoryArea area, IvoryZero area) | |
=> String | Name of variable |
-> Maybe (Init area) | Initial value (or |
-> Ion (Ref Global area) |
Allocate a MemArea
for this Ion
, returning a reference to it.
If the initial value fails to specify the type of this, then an
external signature may be needed (or instead areaP'
). If access
to this variable is needed outside of the Ion
monad, retrieve the
reference from an Ion
with the ionRef
function.
The ModuleDef
for this will be generated automatically.
:: (IvoryArea area, IvoryZero area) | |
=> Proxy area | Proxy (to disambiguate type) |
-> String | Name of variable |
-> Maybe (Init area) | Initial value (or |
-> Ion (Ref Global area) |
Same as area'
, but with an initial Proxy
to disambiguate
the area type.
newAreaP :: (IvoryArea area, IvoryZero area) => Proxy area -> Maybe (Init area) -> Ion (Ref Global area) Source
newProc :: IvoryProcDef proc impl => impl -> Ion (Def proc) Source
This is like Ivory proc
, but using Ion
to give the
procedure a unique name.
newProcP :: IvoryProcDef proc impl => Proxy (Def proc) -> impl -> Ion (Def proc) Source
newProc
with an initial Proxy
to disambiguate the procedure type
adapt_0_1 :: (IvoryType a, IvoryVar a) => Def (`[]` :-> ()) -> Ion (Def (`[a]` :-> ())) Source
All the adapt_X_Y
functions adapt an Ivory procedure which
takes X
arguments and returns nothing, into an Ivory procedure
which takes Y
arguments. If X
> Y
then zero is passed for
the argument(s); if Y
< X
then the additional arguments are
ignored. The generated procedure is automatically included as part
of the Ion
spec. The main point of this is to simplify the
chaining together of Ivory procedures.
adapt_1_0 :: (Num a, IvoryType a, IvoryVar a) => Def (`[a]` :-> ()) -> Ion (Def (`[]` :-> ())) Source
adapt_0_2 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b) => Def (`[]` :-> ()) -> Ion (Def (`[a, b]` :-> ())) Source
adapt_2_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b) => Def (`[a, b]` :-> ()) -> Ion (Def (`[]` :-> ())) Source
adapt_0_3 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c]` :-> ())) Source
adapt_3_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b, Num c, IvoryType c, IvoryVar c) => Def (`[a, b, c]` :-> ()) -> Ion (Def (`[]` :-> ())) Source
adapt_0_4 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c, IvoryType d, IvoryVar d) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c, d]` :-> ())) Source
adapt_4_0 :: (Num a, IvoryType a, IvoryVar a, Num b, IvoryType b, IvoryVar b, Num c, IvoryType c, IvoryVar c, Num d, IvoryType d, IvoryVar d) => Def (`[a, b, c, d]` :-> ()) -> Ion (Def (`[]` :-> ())) Source
adapt_0_5 :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b, IvoryType c, IvoryVar c, IvoryType d, IvoryVar d, IvoryType e, IvoryVar e) => Def (`[]` :-> ()) -> Ion (Def (`[a, b, c, d, e]` :-> ())) Source
:: (a ~ Stored t, Num t, IvoryStore t, IvoryInit t, IvoryEq t, IvoryOrd t, IvoryArea a, IvoryZero a) | |
=> Proxy t | Proxy to resolve timer type |
-> Def (`[]` :-> ()) | Timer expiration procedure |
-> Ion (Ref Global (Stored t)) |
Create a timer resource. The returned Ion
still must be called
at regular intervals (e.g. by including it in a larger Ion spec
that is already active). See startTimer
and stopTimer
to
actually activate this timer.