ion (empty) → 1.0.0.0
raw patch · 10 files changed
+1306/−0 lines, 10 filesdep +basedep +containersdep +ivory
Dependencies added: base, containers, ivory, ivory-backend-c, mtl
Files
- LICENSE +27/−0
- ion.cabal +67/−0
- src/Ivory/Language/Ion.hs +181/−0
- src/Ivory/Language/Ion/Base.hs +97/−0
- src/Ivory/Language/Ion/CPS.hs +90/−0
- src/Ivory/Language/Ion/Code.hs +175/−0
- src/Ivory/Language/Ion/Examples/Example.hs +276/−0
- src/Ivory/Language/Ion/Operators.hs +315/−0
- src/Ivory/Language/Ion/Schedule.hs +27/−0
- src/Ivory/Language/Ion/Util.hs +51/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Chris Hodapp 2015-2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ ion.cabal view
@@ -0,0 +1,67 @@+-- Initial ion.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++name: ion+version: 1.0.0.0+synopsis: EDSL for concurrent, realtime, embedded programming on top of Ivory+description:+ Ion is a Haskell EDSL for concurrent, realtime, embedded programming.+ It interfaces with the Ivory EDSL, <http://ivorylang.org/>, to perform+ code generation. It supports similar scheduling functionality to Atom+ (<https://hackage.haskell.org/package/atom>), and also accomodates+ asynchronous programming with continuation-passing style.++ Be forewarned that Ion is still heavily experimental. For some+ further explanation, see the write-up at HaskellEmbedded,+ <https://haskellembedded.github.io/posts/2016-09-23-introducing-ion.html>.+license: BSD3+license-file: LICENSE+ +author: Chris Hodapp+maintainer: Hodapp87@gmail.com+stability: experimental+homepage: https://haskellembedded.github.io/+-- copyright: +category: Language, Embedded+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/HaskellEmbedded/ion++library+ exposed-modules: Ivory.Language.Ion+ , Ivory.Language.Ion.Base+ , Ivory.Language.Ion.Code+ , Ivory.Language.Ion.CPS+ , Ivory.Language.Ion.Operators+ , Ivory.Language.Ion.Schedule+ , Ivory.Language.Ion.Util+ -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5+ , containers+ , ivory >= 0.1.0.0+ , ivory-backend-c+ , mtl+ hs-source-dirs: src+ default-language: Haskell2010++executable ion_example+ main-is: Ivory/Language/Ion/Examples/Example.hs+ --ghc-options: -threaded -rtsopts -with-rtsopts=-N+ other-modules: Ivory.Language.Ion.Base+ , Ivory.Language.Ion.Code+ , Ivory.Language.Ion.CPS+ , Ivory.Language.Ion.Operators+ , Ivory.Language.Ion.Schedule+ , Ivory.Language.Ion.Util+ build-depends: base+ , containers+ , ivory+ , ivory-backend-c+ , mtl+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Ivory/Language/Ion.hs view
@@ -0,0 +1,181 @@+{- |+Module: Ion+Description: Top-level Ion module+Copyright: (c) 2015 Chris Hodapp++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,+<https://hackage.haskell.org/package/atom 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.)++-}++module Ivory.Language.Ion (+ -- * Base types+ Base.Ion+ , CPS.IonCont+ + -- * Code generation+ , Code.IonExports(..)+ , Code.ionDef++ -- * 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.+ , Operators.ion+ , Operators.phase+ , Operators.delay+ , Operators.period+ , Operators.subPeriod+ , Operators.cond+ , Operators.disable+ + -- ** Memory & Procedures+ , Operators.newName+ , Operators.newProc+ , Operators.newProcP+ , Operators.area'+ , Operators.areaP'+ , Operators.newArea+ , Operators.newAreaP+ + -- ** Effects+ , Operators.ivoryEff+ + -- ** Utilities+ , Operators.timer+ , Operators.startTimer+ , Operators.stopTimer+ , Operators.getPhase+ , Operators.adapt_0_1+ , Operators.adapt_1_0+ , Operators.adapt_0_2+ , Operators.adapt_2_0+ , Operators.adapt_0_3+ , Operators.adapt_3_0+ , Operators.adapt_0_4+ , Operators.adapt_4_0+ , Operators.adapt_0_5+ -- Yes, the 'utilities' aren't in module Util. Whatever.++ -- ** CPS+ , CPS.accum+ + ) where++import qualified Ivory.Language.Ion.Base as Base+import qualified Ivory.Language.Ion.Code as Code+import qualified Ivory.Language.Ion.CPS as CPS+import qualified Ivory.Language.Ion.Operators as Operators+import qualified Ivory.Language.Ion.Util as Util
+ src/Ivory/Language/Ion/Base.hs view
@@ -0,0 +1,97 @@+{- |+Module: Base+Description: Base Ion types+Copyright: (c) 2015 Chris Hodapp++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}++module Ivory.Language.Ion.Base where++import Control.Exception+import Control.Monad.State hiding ( forever )+import Data.Typeable++import qualified Ivory.Language as IL+import Ivory.Language+import qualified Ivory.Language.Monad as ILM++-- | This wraps 'Ion' with the ability to create unique C identifier names.+type Ion = State IonDef++data IonDef = IonDef { ionId :: String -- ^ Unique ID (used as base name)+ , ionNum :: Int -- ^ Next unused number+ , ionDefs :: IL.ModuleDef -- ^ Ivory definitions+ -- that the specifications produce+ , ionCtxt :: Schedule -- ^ The 'inherited' context+ , ionSched :: [Schedule] -- ^ A flat list of+ -- schedule items generated along the way.+ }++defaultIonDef = IonDef { ionId = ""+ , ionNum = 0+ , ionDefs = return ()+ , ionCtxt = defaultSchedule+ , ionSched = []+ }++-- | A scheduled action. Phase and period here are absolute, and there are no+-- child nodes.+data Schedule =+ Schedule { schedId :: Integer -- ^ A unique ID for this action+ , schedName :: String -- ^ Name (without any disambiguation applied)+ , schedPath :: [String] -- ^ A list of names giving the trail that+ -- produced this schedule+ , schedPhase :: Integer -- ^ The (absolute & exact) phase of this+ -- action+ , schedPeriod :: Integer -- ^ The period of this action+ , schedAction :: [IvoryAction ()] -- ^ The Ivory effects for this+ -- action+ , schedCond :: [IvoryAction IL.IBool] -- ^ Ivory effects which all+ -- must return 'true' for anything in 'schedAction'+ -- to execute+ }+ deriving (Show)++defaultSchedule = Schedule { schedId = 0+ , schedName = "root"+ , schedPath = []+ , schedPhase = 0+ , schedPeriod = 1+ , schedAction = []+ , schedCond = []+ }++-- | The type of Ivory action that an 'IonNode' can support. Note that this+-- purposely forbids breaking, returning, and allocating.+type IvoryAction = IL.Ivory IL.NoEffects++instance Show (IvoryAction a) where+ show iv = "Ivory NoEffects () [" ++ show block ++ "]"+ where (_, block) =+ ILM.runIvory $ ILM.noReturn $ ILM.noBreak $ ILM.noAlloc iv++data PhaseContext = Absolute -- ^ Phase is relative to the first tick+ -- within a period+ | Relative -- ^ Phase is relative to the last phase+ -- used+ deriving (Show)++data PhaseType = Min -- ^ Minimum phase (i.e. at this phase, or any+ -- later point)+ | Exact -- ^ Exactly this phase+ deriving (Show)++data IonException = InvalidCName [String] String Int -- ^ Path, C name, and+ -- index at which it is invalid+ | PhaseExceedsPeriod [String] Integer Integer -- ^ Path,+ -- phase, period+ | PhaseIsNegative [String] Integer -- ^ Path, phase+ | PeriodMustBePositive [String] Integer -- ^ Path, period+ deriving (Show, Typeable)++instance Exception IonException
+ src/Ivory/Language/Ion/CPS.hs view
@@ -0,0 +1,90 @@+{- |+Module: CPS+Description: Ion types for continuations & continuation-passing style+Copyright: (c) 2015 Chris Hodapp++-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}++module Ivory.Language.Ion.CPS where++import Ivory.Language++import Ivory.Language.Ion.Base+import Ivory.Language.Ion.Operators++-- | 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.+type IonCont a b = Def (b ':-> ()) -- ^ Continuation function+ -> Ion (Def (a ':-> ())) -- ^ Entry function++-- | 'Lift' a Haskell function up into an 'IonCont'.+lift :: (IvoryType a, IvoryVar a, IvoryType b, IvoryVar b) =>+ (a -> b) -> IonCont '[a] '[b]+lift f cont = newProc $ \a -> body $ call_ cont $ f a++-- | '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.+accum :: (IvoryType a, IvoryVar a, IvoryStore a, IvoryZeroVal a,+ IvoryType b, IvoryVar b) =>+ IonCont '[] '[b] -> IonCont '[a] (a ': '[b]) +accum f_ab cont = do+ -- Temporary variable to hold 'a' while waiting to be called back:+ tempA <- newArea Nothing++ -- Generate a new continuation which calls the continuation with the+ -- temporary 'a' value:+ cont2 <- newProc $ \b -> body $ do+ a <- deref tempA+ call_ cont a b++ -- 'entry2' is the entry function using 'cont2' as the continuation:+ entry2 <- f_ab cont2++ -- And finally, the new entry function:+ entry <- newProc $ \a -> body $ do+ store tempA a+ call_ entry2+ + return entry++-- Another function that will be much more difficult to implement:+join :: (a -> b -> c) -> IonCont t '[a] -> IonCont t '[b] -> IonCont t '[c]+join _ _ _ = undefined++-- This would implement a 'join point' of sorts. The returned IonCont+-- would not call its own continuation until the other two continuations+-- (those of the first two IonCont arguments) have been called. The entry+-- function should call that of both of the arguments.
+ src/Ivory/Language/Ion/Code.hs view
@@ -0,0 +1,175 @@+{- |+Module: Code+Description: Ivory code generation from Ion specifications+Copyright: (c) 2015 Chris Hodapp++This contains functionality for converting the 'Ion' type to Ivory constructs.++Known issues:++ * One must depend on the Ivory module that makes use of the+definitions from 'ionDef' in order to reference a variable declared+with 'area''.+ * It can be really inefficient to require a separate counter for+every distinct phase within a period. Why not reuse variables here+when it's within the same period, and rather than starting at the+phase, counting down, and checking for zero, instead starting just one+variable at 0, counting up, checking for each individual phase?++-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Ivory.Language.Ion.Code where++import Control.Exception+import Control.Monad.State hiding ( forever )++import qualified Ivory.Compile.C.CmdlineFrontend as IC+import Ivory.Language+import Ivory.Language.MemArea ( memSym )+import Ivory.Language.Monad ( emit )+import qualified Ivory.Language.Syntax.AST as AST+import qualified Ivory.Language.Syntax.Names as N+import qualified Ivory.Language.Syntax.Type as Ty++import Ivory.Language.Ion.Base+import Ivory.Language.Ion.Schedule+import Ivory.Language.Ion.Util++-- | Concrete exports from an 'Ion'+data IonExports a = IonExports+ { ionEntry :: Def ('[] ':-> ())+ , ionModule :: ModuleDef+ , ionValue :: a+ }+-- FIXME: Figure out why I must have 'ModuleDef' and a value twice.+-- I'm basically just exporting an 'Ion' (but one that semantically is+-- different) plus an entry procedure.++-- | Helper function to generate code from an 'Ion' and run the Ivory+-- compiler on it (or else output an exception message). While I+-- don't yet know any reason why it needs to, this also returns+-- whatever value the 'Ion' returns.+ionCompile :: IC.Opts -- ^ Options for 'IC.runCompiler'+ -> String -- ^ Name for schedule function and module+ -> Ion a -- ^ Spec+ -> IO a+ionCompile opts name spec = do+ let exps = ionDef name spec+ mod = package name $ ionModule exps+ catch+ (IC.runCompiler [mod] [] opts)+ $ \e -> putStrLn ("Exception: " ++ show (e :: IonException))+ return $ ionValue exps++-- | Produce exports from the given 'Ion' specs.+ionDef :: String -- ^ Name for schedule function+ -> Ion a -- ^ Ion specification+ -> IonExports a+ionDef name s = IonExports { ionEntry = entryProc+ , ionModule = mod+ , ionValue = a+ }+ where -- FIXME: 'defaultIonDef' should probably not be hard-coded.+ -- i0 :: Ion (a, SeqState)+ (a, def) = runState s $ defaultIonDef { ionId = name }+ mod = do ionDefs def+ incl entryProc+ mapM_ incl schedFns+ mapM_ counterDef nodes+ nodes = flatten def+ -- FIXME: This shouldn't just be taking the head node, and we should+ -- probably also not hard-code defaultSchedule.+ -- The entry procedure for running the schedule:+ entryProc :: Def ('[] ':-> ())+ entryProc = proc name $ body $ do+ let nodeComment (sch, _) =+ comment $ "Path: " ++ (foldl1 (\s acc -> (s ++ "." ++ acc)) $+ schedPath sch)+ comment "Auto-generated schedule entry procedure from Ion & Ivory"+ mapM_ (\t -> nodeComment t >> entryEff t) $ zip nodes schedFns+ -- FIXME: Disambiguate the name of this procedure+ schedFns :: [Def ('[] ':-> ())]+ schedFns = map mkSchedFn nodes+ id' sch = "_" ++ (show $ schedId sch)+ -- The name of the counter symbol:+ counterSym sch = "counter_" ++ schedName sch ++ id' sch+ -- The ModuleDef of the counter's MemArea:+ counterDef sch =+ let areaDef :: forall a .+ (IvoryType a, IvoryInit a, IvoryZeroVal a, Num a) =>+ Proxy a -> ModuleDef+ areaDef _ = defMemArea $ area (counterSym sch) $ Just $ ival $+ ((fromIntegral $ schedPhase sch) :: a)+ in case (fitWordType $ schedPeriod sch) of+ (Ty.TyWord Ty.Word8) -> areaDef (Proxy :: Proxy Uint8)+ (Ty.TyWord Ty.Word16) -> areaDef (Proxy :: Proxy Uint16)+ (Ty.TyWord Ty.Word32) -> areaDef (Proxy :: Proxy Uint32)+ (Ty.TyWord Ty.Word64) -> areaDef (Proxy :: Proxy Uint64)+ -- FIXME: Is there a cleaner way to do the above?+ -- FIXME: I think this introduces problems when phase proceeds+ -- period, and phase exceeds a Word8.+ -- The Ivory procedure for some schedule item:+ mkSchedFn sch = proc ("ion_" ++ schedName sch ++ id' sch) $ body $ do+ noReturn $ noBreak $ noAlloc $ getIvory sch+ -- The Ivory effect for invoking a given schedule item:+ entryEff (sch, schFn) = emit $+ AST.IfTE counterZero [callSched, reset] [decr]+ where ty = fitWordType $ schedPeriod sch+ -- Counter variable:+ var = AST.ExpSym $ counterSym sch+ -- Pointer to it (because AST.Store assumes a reference):+ var' = AST.ExpAddrOfGlobal $ counterSym sch+ -- Predicate, true if counter equals zero:+ counterZero = AST.ExpOp (AST.ExpEq ty)+ [var, AST.ExpLit $ AST.LitInteger 0]+ -- True case (counter = 0):+ callSched = AST.Call Ty.TyVoid Nothing+ (AST.NameSym $ procName schFn) []+ -- FIXME: I need to add a condition to 'callSched'+ -- which checks any conditions on 'sch', and move+ -- those conditions out of 'getIvory'. I still need+ -- to find a way of evaluating this condition only at+ -- the proper time. I may have to look at how Atom+ -- did this. The problem is that all of the calls to+ -- sub-nodes are flattened in this function, and each+ -- call must be handled separately.+ -- I also must be mindful that I do not evaluate the Ivory+ -- effect vastly more times than necessary.+ reset = AST.Store ty var' $ AST.ExpLit $+ AST.LitInteger $ fromIntegral (schedPeriod sch - 1)+ -- False case:+ decr = AST.Store ty var' $+ (AST.ExpOp AST.ExpSub+ [var, AST.ExpLit $ AST.LitInteger 1])+-- This perhaps should be seen as an analogue of 'writeC' in Code.hs in Atom.++-- | Produce an Ivory effect from a 'Schedule'.+getIvory :: (eff ~ NoEffects) => Schedule -> Ivory eff ()+-- Originally:+-- (GetBreaks eff ~ NoBreak, GetReturn eff ~ NoReturn, GetAlloc eff ~ NoAlloc)+getIvory i0 = do+ comment "Auto-generated schedule procedure from Ion & Ivory"+ comment $ "Path: " ++ (foldl1 (\s acc -> (s ++ "." ++ acc)) $ schedPath i0)+ comment $ "Phase: " ++ (show $ schedPhase i0)+ comment $ "Period: " ++ (show $ schedPeriod i0)+ let actions = sequence_ $ schedAction i0+ case schedCond i0 of+ -- If no conditions, apply actions directly:+ [] -> do comment "Action has no conditions"+ actions+ -- Otherwise, evaluate & logical AND them all:+ condEffs -> do+ comment $ "Action has " ++ (show $ length condEffs) ++ " conditions:"+ conds <- sequence condEffs+ ifte_ (foldr1 (.&&) conds)+ actions+ $ return ()+ -- FIXME: Short-circuit evaluation might be helpful here. We don't need+ -- to evaluate any other condition as soon as one has failed.+ -- This might be inefficient for other reasons too - we re-evaluate the+ -- same condition in every single sub-node.+ -- FIXME: Can we evaluate Ivory constants at code generation time and+ -- just fully enable/disable the node then?
+ src/Ivory/Language/Ion/Examples/Example.hs view
@@ -0,0 +1,276 @@+{- |+Module: Example+Description: Example Ion modules & code generation+Copyright: (c) 2015 Chris Hodapp++-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE TypeOperators #-}++module Main where++import Data.Word++import Ivory.Language+import Ivory.Compile.C.CmdlineFrontend++import Ivory.Language.Ion.Base+import Ivory.Language.Ion.Code+import Ivory.Language.Ion.Operators++main :: IO ()+main = do+ let ivoryOpts = initialOpts { scErrors = False+ , srcLocs = True+ , outDir = Nothing+ }+ ionCompile ivoryOpts "simpleSchedule" simpleSchedule+ ionCompile ivoryOpts "timer" exampleTimer+ ionCompile ivoryOpts "exampleChain" exampleChain+ ionCompile ivoryOpts "giant_ugly_test" test+ return ()++printf :: Def ('[IString] :-> Sint32)+printf = importProc "printf" "stdio.h"++-- void foo(int16_t)+foo :: Def ('[] :-> ())+foo = importProc "foo" "something.h"++-- void bar(int32_t)+bar :: Def ('[] :-> ())+bar = importProc "bar" "something.h"++-- uint16_t get_value(int32_t)+get_value :: Def ('[] :-> Uint16)+get_value = importProc "get_value" "something.h"++-- bool get_flag(void)+get_flag :: Def ('[] :-> IBool)+get_flag = importProc "get_flag" "something.h"++simpleSchedule :: Ion ()+simpleSchedule = ion "schedule" $ do+ + period 100 $ do+ variousPhases++ cond ((>? 10) <$> call get_value) $ do+ ivoryEff $ comment "get_value() > 10"+ cond (call get_flag) $ do+ ivoryEff $ comment "get_value() > 10 && get_flag()"++variousPhases :: Ion ()+variousPhases = do+ phase 1 $ ivoryEff $ do+ comment "period 100, phase 1"+ call_ foo+ phase 10 $ ion "optional_tag" $ ivoryEff $ do+ comment "period 100, phase 10"+ call_ bar+ disable $ phase 20 $ ivoryEff $ do+ comment "shouldn't even appear in code"+ call_ foo+ call_ bar+ delay 50 $ do+ p <- getSched+ ivoryEff $ do+ comment "Should be phase 100 + 50"+ comment ("Reported sched: " ++ show p)+ delay 10 $ ion "moreDelay" $ do+ p <- getSched+ ivoryEff $ do+ comment "Should be phase 100 + 50 + 10"+ comment ("Reported sched: " ++ show p)+ phase 1 $ do+ ivoryEff $ comment "Should override to phase 1"+ period 1000 $ do+ ivoryEff $ comment "Should override all other period"++-- This returns its own entry procedure (init). The schedule procedure+-- must be called at regular intervals for the timer to function.+exampleTimer :: Ion (Def ('[] ':-> ()))+exampleTimer = ion "timer" $ mdo+ -- Note the use of 'mdo' so that we can define things in a more+ -- logical order.+ + -- Timer is initialized with a Uint16; procedure called at+ -- expiration is fixed at compile-time:+ timer1 <- period 1 $ timer (Proxy :: Proxy Uint16) expire++ -- Initialization procedure:+ init <- newProc $ body $ do+ -- Trigger the timer for 1000 ticks:+ startTimer timer1 1000+ + expire <- newProc $ body $ do+ call_ printf "Timer expired!\r\n"++ return init++-- | This is an example of chaining together a variety of calls and+-- async callbacks in continuation-passing style.+exampleChain :: Ion (Def ('[] ':-> ()))+exampleChain = mdo+ let error :: Def ('[Uint32] :-> ())+ error = importProc "assert_error" "foo.h"++ -- Chain together four calls with different values. The final+ -- call is the 'success' function.+ init <- exampleSend 0x1234 error =<<+ adapt_0_1 =<< exampleSend 0x2345 error =<<+ adapt_0_1 =<< exampleSend 0x3456 error =<<+ adapt_0_1 =<< exampleSend 0x4567 error success+ -- adapt_0_1 is required to match the success callback (which takes a+ -- single Uint16) with the entry function of 'exampleSend' (which takes no+ -- arguments).++ success <- newProc $ \_ -> body $ do+ call_ printf "All calls succeeded!\r\n"++ return init++-- | This definition accepts a payload to transmit, an error callback,+-- and a success callback; it returns the entry function which+-- transmits that value, awaits the async call, and if the result is+-- correct, calls the success callback. If any of these steps go+-- wrong, it calls the error handler with an error code, and proceeds+-- no further.+exampleSend :: Word16 -- ^ Payload value (or something like that)+ -> Def ('[Uint32] ':-> ()) -- ^ Error callback+ -> Def ('[Uint16] ':-> ()) -- ^ Success callback+ -> Ion (Def ('[] ':-> ()))+exampleSend payload err succ = mdo+ -- Make up a hypothetical function which takes a Uint16 payload to+ -- transmit, and a function pointer to a callback. It returns a+ -- Uint32 that is an error code. The function pointer itself takes+ -- a Uint16 which is the value received, and returns nothing.+ let transmit_async :: Def ('[Uint16, ProcPtr ('[Uint16] :-> ())] :-> Uint32)+ transmit_async = importProc "transmit_async" "foo.h"++ write <- newProc $ body $ do+ comment $ "Transmit value: " ++ show payload+ -- Tell transmit_async to transmit this, and call us back at 'recv'+ -- (which we define after):+ errCode <- call transmit_async (fromIntegral payload) $ procPtr recv+ -- Check for a nonzero error code:+ ifte_ (errCode /=? 0)+ (call_ err errCode)+ $ return ()++ recv <- newProc $ \value -> body $ do+ -- Say that hypothetically we should have received the same value+ -- back, so check this first:+ ifte_ (value /=? fromIntegral payload)+ -- If a mismatch, then call the error handler with some code:+ (call_ err 0x12345678)+ -- Otherwise, call the success handler:+ $ call_ succ value++ return write++-- Problems with this spec should be fixed but it's good to have+-- around as an example:+leakageBug :: Ion ()+leakageBug = ion "leakageBug" $ do+ period 200 $ do+ expr <- newProc $ body $ retVoid+ initTimer <- period 1 $ timer (Proxy :: Proxy Uint16) expr+ ion "otherstuff" $ ivoryEff $ do+ comment "Should be period 200 (inherited)"++-- Likewise, problems with this spec should be fixed but it's good to+-- have around as an example:+lostAttribBug :: Ion ()+lostAttribBug = period 200 $ ion "lostAttribBug" $ do+ phase 100 $ ion "moreStuff" $ do+ p <- getSched+ ivoryEff $ do+ comment "Phase 100"+ comment ("Reported sched: " ++ show p)+ delay 3 $ do+ p <- getSched+ ivoryEff $ do+ comment "Should be phase 103"+ comment ("Reported sched: " ++ show p)+ delay 10 $ ion "moreDelay" $ do+ p <- getSched+ ivoryEff $ do+ comment "Should be phase 113"+ comment ("Reported sched: " ++ show p)++baz :: Ion ()+baz = ion "extBaz1" $ phase 10 $ do+ ivoryEff $ comment "should be phase 10"+ phase 20 $ ivoryEff $ comment "should be phase 20"++baz2 :: Ion ()+baz2 = phase 10 $ ion "extBaz2" $ do+ ivoryEff $ comment "should be phase 10"++delayTest :: Ion ()+delayTest = ion "delayTest" $ period 100 $ do+ ivoryEff $ comment "should be phase 0"+ delay 10 $ ion "named" $ ivoryEff $ comment "delay 10 #1"+ delay 10 $ ivoryEff $ comment "delay 10 #2"+ delay 10 $ ivoryEff $ comment "delay 10 #3"+ ion "delayTest2" $ do+ delay 20 $ ivoryEff $ comment "should have inherited delay"++-- | The below does nothing useful, but is left here because it served+-- to illuminate many pesky bugs in Ion.+test :: Ion ()+test = ion "Foo" $ do++ test <- areaP' (Proxy :: Proxy (Stored Uint16)) "testMem" Nothing++ leakageBug++ lostAttribBug++ period 20 $ do+ ivoryEff $ comment "period 20a"+ ivoryEff $ comment "period 20b"+ ivoryEff $ comment "period 20c"+ ivoryEff $ comment "period 20d"+ period 30 $ ivoryEff $ comment "period 30 overwriting 20"++ period 1 $ disable $ do+ ivoryEff $ comment "shouldn't appear in code"+ period 30 $ ivoryEff $ comment "also shouldn't appear in code"+ undefined++ -- Period 1:+ ion "Bar" $ do+ ivoryEff $ comment "Foo.Bar"+ ivoryEff $ comment "Foo.Bar 2"++ ion "Baz" $ period 1500 $ do+ ivoryEff $ comment "Foo.Baz period 15"+ ivoryEff $ comment "Foo.Baz period 15b"++ period 75 $ do+ baz+ baz2++ -- FIXME: delayTest improperly inherits phase 10 from baz2.+ period 100 $ do+ delayTest++ disable $ ion "disabled" $ period 60000 $ do+ ivoryEff $ comment "Should be disabled"++ cond (return false) $ ion "condTest" $ do+ ivoryEff $ comment "Conditional test"+ ion "condTest1" $ ivoryEff $ comment "Conditional test sub 1"+ ion "condTest2" $ ivoryEff $ comment "Conditional test sub 2"+ ion "condTest3" $ ivoryEff $ comment "Conditional test sub 3"+ cond (return true) $ ion "twoConds" $ do+ ivoryEff $ comment "Two conditions"+ ion "condTest4" $ ivoryEff $ comment "Also two conditions"+++ cond (return true) $ ion "condTest2" $ do+ ivoryEff $ comment "Should have just one condition"
+ src/Ivory/Language/Ion/Operators.hs view
@@ -0,0 +1,315 @@+{- |+Module: Operators+Description: Operators used in creating Ion specifications+Copyright: (c) 2015 Chris Hodapp++-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Ivory.Language.Ion.Operators where++import Control.Applicative ( (<$>) )+import Control.Exception+import Control.Monad+import Control.Monad.State hiding ( forever )++import qualified Ivory.Language as IL+import qualified Ivory.Language.Monad as ILM+import Ivory.Language.Proc ( Def(..), Proc(..), IvoryCall_,+ IvoryProcDef )++import Ivory.Language.Ion.Base+import Ivory.Language.Ion.Schedule+import Ivory.Language.Ion.Util++-- | Transform a sub-node according to a function which transforms+-- 'Schedule' items, and then collect the state from it.+addAction :: (Schedule -> Schedule) -> Ion a -> Ion a+addAction fn sub = do+ start <- get+ -- 'Run' the sub-node, passing in a minimal starting state (except+ -- for the unique ID & name):+ let temp = IonDef+ { ionId = ionId start+ , ionNum = ionNum start+ , ionCtxt = fn $ ionCtxt start+ -- FIXME: How much is ionCtxt needed, considering+ -- that we copy it?+ , ionDefs = return ()+ , ionSched = [fn $ ionCtxt start]+ }+ (a, def) = runState sub temp+ -- Collect some of the state that the sub-node produced:+ put $ start { ionNum = ionNum def+ , ionDefs = ionDefs start >> ionDefs def+ -- , ionTree = ionTree start ++ [Tree.Node act $ ionTree def]+ , ionSched = ionSched start ++ ionSched def+ }+ return a++getSched :: Ion Schedule+getSched = ionCtxt <$> get++getPhase :: Ion Integer+getPhase = schedPhase <$> ionCtxt <$> get++-- | 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.+ion :: String -- ^ Name+ -> Ion a -- ^ Sub-node+ -> Ion a+ion name = addAction setName+ where setName sch = case checkCName name of+ Just i -> throw $ InvalidCName (schedPath sch) name i+ Nothing -> sch { schedName = name+ , schedPath = schedPath sch ++ [name]+ }++phaseSet :: Integral i => i -> Schedule -> Schedule+phaseSet ph sch = if (ph' >= schedPeriod sch)+ then throw $+ PhaseExceedsPeriod (schedPath sch) ph' (schedPeriod sch)+ else sch { schedPhase = ph' }+ where ph' = fromIntegral ph++-- | 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.+delay :: Integral i =>+ i -- ^ Relative phase+ -> Ion a -- ^ Sub-node+ -> Ion a+delay ph = addAction setDelay+ where setDelay sch = phaseSet (schedPhase sch + fromIntegral ph) sch++-- | 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.+phase :: Integral i =>+ i -- ^ Phase+ -> Ion a -- ^ Sub-node+ -> Ion a+phase ph = addAction (phaseSet ph)++-- | 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.+period :: Integral i =>+ i -- ^ Period+ -> Ion a -- ^ Sub-node+ -> Ion a+period p = addAction setPeriod+ where p' = fromIntegral p+ setPeriod sch = if (p' <= 0)+ then throw $ PeriodMustBePositive (schedPath sch) p'+ else sch { schedPeriod = p' }++-- | 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.+subPeriod :: Integral i =>+ i -- ^ Factor by which to multiply period (must be positive)+ -> Ion a -- ^ Sub-node+ -> Ion a+subPeriod f = addAction divPeriod+ where divPeriod sch = let p = schedPeriod sch * fromIntegral f+ in if (p <= 0)+ then throw $ PeriodMustBePositive (schedPath sch) p+ else sch { schedPeriod = p }++-- | 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'.+disable :: Ion a -> Ion ()+disable _ = return ()+-- FIXME: Explain this better. 'disable' and 'cond' only apply to certain+-- things.++-- | 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).+cond :: IvoryAction IL.IBool -> Ion a -> Ion a+cond pred = addAction setCond+ where setCond sch = sch { schedCond = pred : schedCond sch }++-- | Attach an Ivory effect to an 'Ion'. This effect will execute at+-- the inherited phase and period of the node.+ivoryEff :: IvoryAction () -> Ion ()+ivoryEff iv = addAction addEff $ return ()+ where addEff sch = sch { schedAction = schedAction sch ++ [iv] }++-- | Return a unique name.+newName :: Ion String+newName = do state <- get+ let num' = ionNum state+ put $ state { ionNum = num' + 1 }+ return $ ionId state ++ "_" ++ show num'++-- | Allocate a 'IL.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.+area' :: (IL.IvoryArea area, IL.IvoryZero area) =>+ String -- ^ Name of variable+ -> Maybe (IL.Init area) -- ^ Initial value (or 'Nothing')+ -> Ion (IL.Ref IL.Global area)+area' name init = do+ let mem = IL.area name init+ state <- get+ put $ state { ionDefs = ionDefs state >> IL.defMemArea mem }+ return $ IL.addrOf mem++-- | Same as 'area'', but with an initial 'IL.Proxy' to disambiguate+-- the area type.+areaP' :: (IL.IvoryArea area, IL.IvoryZero area) =>+ IL.Proxy area -- ^ Proxy (to disambiguate type)+ -> String -- ^ Name of variable+ -> Maybe (IL.Init area) -- ^ Initial value (or 'Nothing')+ -> Ion (IL.Ref IL.Global area)+areaP' _ = area'++-- | 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.)+newArea :: (IL.IvoryArea area, IL.IvoryZero area) =>+ Maybe (IL.Init area) -> Ion (IL.Ref IL.Global area)+newArea init = mkArea =<< newName+ where mkArea name = area' name init++-- | This is 'areaP'', but using 'Ion' to create a unique name.+newAreaP :: (IL.IvoryArea area, IL.IvoryZero area) =>+ IL.Proxy area -> Maybe (IL.Init area) ->+ Ion (IL.Ref IL.Global area)+newAreaP _ = newArea++-- | This is like Ivory 'proc', but using 'Ion' to give the+-- procedure a unique name.+newProc :: (IvoryProcDef proc impl) => impl -> Ion (Def proc)+newProc impl = do+ name <- newName+ state <- get+ let fn sym = IL.proc sym impl+ put $ state { ionDefs = ionDefs state >> (IL.incl $ fn name) }+ return $ fn name++-- | 'newProc' with an initial 'Proxy' to disambiguate the procedure type+newProcP :: (IvoryProcDef proc impl) =>+ IL.Proxy (Def proc) -> impl -> Ion (Def proc)+newProcP _ = newProc++-- | 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_0_1 :: (IL.IvoryType a, IL.IvoryVar a) =>+ Def ('[] ':-> ()) -> Ion (Def ('[a] ':-> ()))+adapt_0_1 fn0 = newProc $ \_ -> IL.body $ IL.call_ fn0++adapt_1_0 :: (Num a, IL.IvoryType a, IL.IvoryVar a) =>+ Def ('[a] ':-> ()) -> Ion (Def ('[] ':-> ()))+adapt_1_0 fn0 = newProc $ IL.body $ IL.call_ fn0 0++adapt_0_2 :: (IL.IvoryType a, IL.IvoryVar a, IL.IvoryType b, IL.IvoryVar b) =>+ Def ('[] ':-> ()) -> Ion (Def ('[a,b] ':-> ()))+adapt_0_2 fn0 = newProc $ \_ _ -> IL.body $ IL.call_ fn0++adapt_2_0 :: (Num a, IL.IvoryType a, IL.IvoryVar a, Num b, IL.IvoryType b,+ IL.IvoryVar b) =>+ Def ('[a, b] ':-> ()) -> Ion (Def ('[] ':-> ()))+adapt_2_0 fn0 = newProc $ IL.body $ IL.call_ fn0 0 0++adapt_0_3 :: (IL.IvoryType a, IL.IvoryVar a, IL.IvoryType b, IL.IvoryVar b,+ IL.IvoryType c, IL.IvoryVar c) =>+ Def ('[] ':-> ()) -> Ion (Def ('[a,b,c] ':-> ()))+adapt_0_3 fn0 = newProc $ \_ _ _ -> IL.body $ IL.call_ fn0++adapt_3_0 :: (Num a, IL.IvoryType a, IL.IvoryVar a, Num b, IL.IvoryType b,+ IL.IvoryVar b, Num c, IL.IvoryType c, IL.IvoryVar c) =>+ Def ('[a, b, c] ':-> ()) -> Ion (Def ('[] ':-> ()))+adapt_3_0 fn0 = newProc $ IL.body $ IL.call_ fn0 0 0 0++adapt_0_4 :: (IL.IvoryType a, IL.IvoryVar a, IL.IvoryType b, IL.IvoryVar b,+ IL.IvoryType c, IL.IvoryVar c, IL.IvoryType d, IL.IvoryVar d) =>+ Def ('[] ':-> ()) -> Ion (Def ('[a,b,c,d] ':-> ()))+adapt_0_4 fn0 = newProc $ \_ _ _ _ -> IL.body $ IL.call_ fn0++adapt_4_0 :: (Num a, IL.IvoryType a, IL.IvoryVar a, Num b, IL.IvoryType b,+ IL.IvoryVar b, Num c, IL.IvoryType c, IL.IvoryVar c, Num d,+ IL.IvoryType d, IL.IvoryVar d) =>+ Def ('[a, b, c, d] ':-> ()) -> Ion (Def ('[] ':-> ()))+adapt_4_0 fn0 = newProc $ IL.body $ IL.call_ fn0 0 0 0 0++adapt_0_5 :: (IL.IvoryType a, IL.IvoryVar a, IL.IvoryType b, IL.IvoryVar b,+ IL.IvoryType c, IL.IvoryVar c, IL.IvoryType d, IL.IvoryVar d,+ IL.IvoryType e, IL.IvoryVar e) =>+ Def ('[] ':-> ()) -> Ion (Def ('[a,b,c,d,e] ':-> ()))+adapt_0_5 fn0 = newProc $ \_ _ _ _ _ -> IL.body $ IL.call_ fn0++-- FIXME: I am almost certain that a better way exists than what I did+-- above - perhaps using typeclasses and mimicking what Ivory did to+-- define the functions.++-- | 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.+timer :: (a ~ 'IL.Stored t, Num t, IL.IvoryStore t, IL.IvoryInit t,+ IL.IvoryEq t, IL.IvoryOrd t, IL.IvoryArea a, IL.IvoryZero a) =>+ IL.Proxy t -- ^ Proxy to resolve timer type+ -> Def ('[] ':-> ()) -- ^ Timer expiration procedure+ -> Ion (IL.Ref IL.Global (IL.Stored t))+timer _ expFn = do+ name <- newName++ ion name $ do+ var <- area' name $ Just $ IL.ival 0+ + ion "decr" $ ivoryEff $ do+ val <- IL.deref var+ IL.ifte_ (val IL.==? 0) (return ()) -- Do nothing if already 0+ -- Otherwise, decrement+ $ do let val' = val - 1+ IL.store var (val')+ -- If it transitions to 0, then call the expiration proc+ IL.ifte_ (val' IL.>? 0) (return ()) $ IL.call_ expFn++ return var+-- FIXME: If the timer expiration procedure is to be fixed at+-- compile-time, maybe I should also just allow Ivory effects. This+-- might make for lighter code and drop the need to make a new+-- function as a handler.++-- | Begin counting a timer down by the given number of ticks.+startTimer :: (Num t, IL.IvoryStore t, IL.IvoryZeroVal t) =>+ IL.Ref IL.Global (IL.Stored t) -- ^ Timer from 'timer'+ -> Integer -- ^ Countdown time+ -> ILM.Ivory eff ()+startTimer ref n = IL.store ref $ fromInteger n+-- FIXME: Will this even work right in usage? Think of whether or not+-- the variable will be in scope. Must these be in the same module?++-- | Stop a timer from running.+stopTimer ref = startTimer ref 0
+ src/Ivory/Language/Ion/Schedule.hs view
@@ -0,0 +1,27 @@+{- |+Module: Schedule+Description: Types and functions for flattened schedule+Copyright: (c) 2015 Chris Hodapp++-}+module Ivory.Language.Ion.Schedule where++import qualified Ivory.Language as IL++import Ivory.Language.Ion.Base+import Ivory.Language.Ion.Util++-- | Produce a flat list of scheduled actions.+flatten :: IonDef -> [Schedule]+flatten i = uniqueIds 0 $ prune $ ionSched i+ -- join $ map (flattenTree defaultSchedule) $ ionTree i++-- | Prune any schedule item that has no Ivory actions.+prune :: [Schedule] -> [Schedule]+prune = filter (not . null . schedAction)++-- | Assign unique IDs to the list of schedule items, starting from the given+-- ID.+uniqueIds :: Integer -> [Schedule] -> [Schedule]+uniqueIds _ [] = []+uniqueIds n (x:xs) = (x { schedId = n }) : uniqueIds (n + 1) xs
+ src/Ivory/Language/Ion/Util.hs view
@@ -0,0 +1,51 @@+{- |+Module: Util+Description: Utility functions used throughout Ion+Copyright: (c) 2015 Chris Hodapp++-}+module Ivory.Language.Ion.Util where++import Data.Char ( isAlpha, isDigit )++import Ivory.Language+import Ivory.Language.Proc ( Def(..), IvoryCall_ )+import qualified Ivory.Language.Syntax.AST as AST+import qualified Ivory.Language.Syntax.Type as Ty++-- | Return the symbol name of an Ivory procedure+procName :: Def proc -> String+procName def = case def of+ DefProc p -> AST.procSym p+ DefImport i -> AST.importSym i++-- | Return the Ivory unsigned int type (in its AST) that the given 'Integer'+-- would require (i.e. any value from 0 to 255 returns a 'Ty.Word8'; values+-- beyond that but less than 65535 require a 'Ty.Word16'; and so on.)+-- The given integer must be non-negative.+fitWordType :: Integer -> Ty.Type+fitWordType i = + if (i < 0)+ then error ("fitWordType: Integer " ++ show i ++ " is negative.")+ else+ if (i < 2^8) then Ty.TyWord Ty.Word8+ else+ if (i < 2^16) then Ty.TyWord Ty.Word16+ else+ if (i < 2^32) then Ty.TyWord Ty.Word32+ else+ if (i < 2^64) then Ty.TyWord Ty.Word64+ else error ("fitWordType: Integer " ++ show i ++ " is too large.")++-- | Checks the given string for being a valid C identifier. If it is, then+-- it returns 'Nothing', and otherwise 'Just' and the string index of the+-- character which renders it invalid.+checkCName :: String -> Maybe Int+checkCName [] = Just 0 -- empty identifier is not allowed+checkCName str = check str 0+ where check :: String -> Int -> Maybe Int+ check [] _ = Nothing+ check (c:cs) i = if (isAlpha c || '_' == c || (i > 0 && isDigit c))+ then check cs (i + 1)+ else Just i+