ion-1.0.0.0: EDSL for concurrent, realtime, embedded programming on top of Ivory

Copyright(c) 2015 Chris Hodapp
Safe HaskellNone
LanguageHaskell2010

Ivory.Language.Ion

Contents

Description

Ion is a Haskell EDSL for concurrent, realtime, embedded programming. It performs compile-time scheduling, and produces scheduling code with constant memory usage and deterministic execution (i.e. no possibility for divergence).

It interfaces with another, more powerful EDSL, <http://ivorylang.org/ Ivory>, to perform code generation. Ivory is responsible for all the code generation to perform the scheduling. One may also embed general Ivory effects in an Ion spec with few restrictions, however, it does very little to enforce constant memory usage or deterministic code here.

Ion generates scheduling code which must be called at regular clock ticks (i.e. from a timer interrupt). The interval of these clock ticks establishes the *base rate* of the system. All scheduled events in the system take place relative to this base rate, defined in terms of period (interval of repetition) and phase (position within that interval).

This functionality is expressed in the Ion monad - in large part to allow composition and modularity in expressing tightly-scheduled functionality. In addition, it has functions like newProc and newArea which define uniquely-named C functions and globals. The purpose of these is to allow that same compositional when working with Ivory definitions that are parametrized and may be instantiated multiple times.

For instance, when dealing with functions that return via asynchronous callbacks or interrupts - a common thing on embedded systems - one must generally work in continuation-passing style. This simplifies the process of creating a reusable pattern for a use-case like:

  1. Transmit instruction I over SPI. Wait to receive 2 bytes.
  2. In a callback: Check that result for being an error condition. If an error, call error handler function E. If successful, transmit instruction I2 and wait to receive 2 bytes.
  3. In a callback: Check for error and call E if needed. If successful, combine result into some composite value, and call success handler S with that value.

and then parametrizing this whole definition over instructions I and I2, error handler E, and success handler S. This definition then could be parametrized over multiple different instructions, and all of these chained together (e.g. via (=<<)) to create a larger sequence of calls passing control via CPS.

Ion was heavily inspired by another EDSL, Atom. It started as an Atom re-implementation which had other backends, rather than generating C code directly (as Atom does). However, Ion has diverged somewhat, and still does not have many things from Atom, such as synchronous variable access, run-time checks on execution time, various compile-time sanity checks, traces, or most of its standard library.

To-do items:

  • Continue writing documentation and examples!
  • Get some unit tests for things that I am prone to breaking.
  • It *still* does not handle minimum phase.
  • This could use a way to invert a phase, and run at every phase but the ones noted.
  • I need to convert over the schedule function in Scheduling.hs in Atom.
  • Atom treats everything within a node as happening at the same time, and I do not handle this yet, though I rather should. This may be complicated - I may either need to process the Ivory effect to look at variable references, or perhaps add certain features to the monad.
  • Atom had a way to express things like rising or falling edges, and debouncing. How possible is this to express?
  • Right now one can only pass variables to an Ion by way of a Ref or some derivative, and those must then be dereferenced inside of an ivoryEff call. Is this okay? Should we make this more flexible somehow? (I feel like Atom did it similarly, with V & E.)
  • Pretty-printing the schedule itself (as Atom does) would probably be a good idea.
  • Consider the case where one puts a condition on a node, and that node has many sub-nodes across various delays. Now, suppose that that condition becomes false somewhere in the middle of those delays. Is the entire node blocked from taking effect, or does it partially take effect? When is the condition considered as being evaluated? Right now it is evaluated at every single sub-node that inherits it. I consider this to be a violation of how Ion should operate - synchronously and atomically.
  • Could ivoryEff meaningfully return a value to Ion rather than ()?
  • Would it be possible to make a CFG for the continuation-passing style arrangements? (Might Ivory have to handle this?)
  • Runtime check: Schedule function being called twice in one clock tick.
  • Runtime check: Schedule function never called in a clock tick.
  • Runtime check: Schedule function hasn't returned yet when next clock tick occurs (i.e. schedule function takes too long).
  • Runtime check: Compute percent utilization, time-wise, in schedule function.
  • Compile-time check: Same period and phase occupied. (Atom would throw a compile-time error when this happened.)

Synopsis

Base types

type Ion = State IonDef Source

This wraps Ion with the ability to create unique C identifier names.

type IonCont a b Source

Arguments

 = Def (b :-> ())

Continuation function

-> Ion (Def (a :-> ()))

Entry function

This wraps a pattern of functions calling each other in continuation-passing style. The intent is that the returned entry function (which takes arguments a) causes the supplied continuation function to be called (passing arguments b).

This is a common pattern for asynchronous calls, for instance, in which the callback or interrupt calls the continuation function.

Multiple calls of this sort can be composed with '(=<<)' (and with RecursiveDo and mdo) to chain them in the order in which they would proceed.

For instance, in start <- call1 =<< call2 =<< call3 final, start contains the entry function to call1, whose continuation is set to the entry function of call2, whose continuation in turn is set to the entry function of call3, whose continuation is final. Note that chaining these with '(>>=)' is possible too, but the order is somewhat reversed from what is logical - hence, mdo often being sensible here.

Code generation

data IonExports a Source

Concrete exports from an Ion

Constructors

IonExports 

Fields

ionEntry :: Def (`[]` :-> ())
 
ionModule :: ModuleDef
 
ionValue :: a
 

ionDef Source

Arguments

:: String

Name for schedule function

-> Ion a

Ion specification

-> IonExports a 

Produce exports from the given Ion specs.

Operators

Compositional

These functions all have Ion a -> Ion a (or similar) at the end of their type, and that is because they are meant to be nested by function composition. For instance:

ion "top_level" $ do
    ion "sub_spec" $ period 100 $ do
         ion "phase0" $ phase 0 $ do
             -- Everything here inherits period 100, phase 0, and
             -- a new path "top_level.sub_spec.phase0".
         phase 20 $ phase '30' $ do
             -- Everything here inherits period 100, and phase 30
         phase 40 $ cond (return true) $ do
             -- Everything here inherits period 100, phase 40, and
             -- a (rather vacuous) condition
         disable $ phase 50 $ do
             -- This is all disabled.

Note that more inner bindings override outer ones in the case of phase, delay, period, and subPeriod. Applications of cond combine with each other as a logical and. Applications of disable are idempotent.

ion Source

Arguments

:: String

Name

-> Ion a

Sub-node

-> Ion a 

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.

phase Source

Arguments

:: Integral i 
=> i

Phase

-> Ion a

Sub-node

-> Ion a 

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.

delay Source

Arguments

:: Integral i 
=> i

Relative phase

-> Ion a

Sub-node

-> Ion a 

Specify a relative, minimum delay for a sub-node - i.e. a minimum offset past the phase that is inherited. For instance, in the example,

    phase 20 $ do
       phase 40 $ foo
       delay 2 $ bar
       delay 2 $ baz

foo and bar both run at a (minimum) phase of 22, because the entire do block inherits that minimum phase.

period Source

Arguments

:: Integral i 
=> i

Period

-> Ion a

Sub-node

-> Ion a 

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.

subPeriod Source

Arguments

:: Integral i 
=> i

Factor by which to multiply period (must be positive)

-> Ion a

Sub-node

-> Ion a 

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.

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).

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.

Memory & Procedures

newName :: Ion String Source

Return a unique name.

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

area' Source

Arguments

:: (IvoryArea area, IvoryZero area) 
=> String

Name of variable

-> Maybe (Init area)

Initial value (or Nothing)

-> 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.

areaP' Source

Arguments

:: (IvoryArea area, IvoryZero area) 
=> Proxy area

Proxy (to disambiguate type)

-> String

Name of variable

-> Maybe (Init area)

Initial value (or Nothing)

-> Ion (Ref Global area) 

Same as area', but with an initial Proxy to disambiguate the area type.

newArea :: (IvoryArea area, IvoryZero area) => Maybe (Init area) -> Ion (Ref Global area) Source

This is area', but using Ion to create a unique name. (The purpose for this is to help with composing an Ion or instantiating one multiple times.)

newAreaP :: (IvoryArea area, IvoryZero area) => Proxy area -> Maybe (Init area) -> Ion (Ref Global area) Source

This is areaP', but using Ion to create a unique name.

Effects

ivoryEff :: IvoryAction () -> Ion () Source

Attach an Ivory effect to an Ion. This effect will execute at the inherited phase and period of the node.

Utilities

timer Source

Arguments

:: (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.

startTimer Source

Arguments

:: (Num t, IvoryStore t, IvoryZeroVal t) 
=> Ref Global (Stored t)

Timer from timer

-> Integer

Countdown time

-> Ivory eff () 

Begin counting a timer down by the given number of ticks.

stopTimer :: (Num t, IvoryStore t, IvoryZeroVal t) => Ref Global (Stored * t) -> Ivory eff () Source

Stop a timer from running.

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

CPS

accum :: (IvoryType a, IvoryVar a, IvoryStore a, IvoryZeroVal a, IvoryType b, IvoryVar b) => IonCont `[]` `[b]` -> IonCont `[a]` (a : `[b]`) Source

Accumulate an argument into a continuation function. Specifically: Given an IonCont taking some argument in its entry function, generate another IonCont with the same type of entry function, but whose continuation function contains another argument (which will receive the same value of that argument).

Note that every use of this requires a static variable of type a. Also, this implementation does not protect against the continuation function being called without the entry function; if this occurs, the continuation will contain old values of a from earlier invocations, or possibly a zero value.

TODO: Right now this handles only converting single-argument to double-argument. I intend to modify this to work similarly to call and callAux in Ivory.