packages feed

atom 0.0.1 → 0.0.2

raw patch · 11 files changed

+246/−74 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Language.Atom.Expressions: Cust :: String -> E a
- Language.Atom.Expressions: UCust :: Type -> String -> UE
- Language.Atom.Expressions: customDouble :: String -> E Double
+ Language.Atom.Elaboration: var' :: Name -> Type -> Atom (V a)
+ Language.Atom.Example: compileExample :: IO ()
+ Language.Atom.Example: example :: Atom ()
+ Language.Atom.Expressions: External :: Type -> UVLocality
+ Language.Atom.Expressions: Local :: Const -> UVLocality
+ Language.Atom.Expressions: data UVLocality
+ Language.Atom.Expressions: instance Show UVLocality
+ Language.Atom.Language: bool' :: Name -> Atom (V Bool)
+ Language.Atom.Language: double' :: Name -> Atom (V Double)
+ Language.Atom.Language: float' :: Name -> Atom (V Float)
+ Language.Atom.Language: int16' :: Name -> Atom (V Int16)
+ Language.Atom.Language: int32' :: Name -> Atom (V Int32)
+ Language.Atom.Language: int64' :: Name -> Atom (V Int64)
+ Language.Atom.Language: int8' :: Name -> Atom (V Int8)
+ Language.Atom.Language: nextCoverage :: Atom (E Word32, E Word32)
+ Language.Atom.Language: var' :: Name -> Type -> Atom (V a)
+ Language.Atom.Language: word16' :: Name -> Atom (V Word16)
+ Language.Atom.Language: word32' :: Name -> Atom (V Word32)
+ Language.Atom.Language: word64' :: Name -> Atom (V Word64)
+ Language.Atom.Language: word8' :: Name -> Atom (V Word8)
- Language.Atom.Code: writeC :: Name -> String -> String -> String -> [[[Rule]]] -> [UV] -> IO ()
+ Language.Atom.Code: writeC :: Name -> [[[Rule]]] -> [UV] -> IO ()
- Language.Atom.Compile: compile :: Name -> String -> String -> String -> Atom () -> Int -> IO ()
+ Language.Atom.Compile: compile :: Name -> Atom () -> IO ()
- Language.Atom.Expressions: UV :: Int -> String -> Const -> UV
+ Language.Atom.Expressions: UV :: Int -> String -> UVLocality -> UV
- Language.Atom.Scheduling: schedule :: [Rule] -> IO (Maybe [[[Rule]]])
+ Language.Atom.Scheduling: schedule :: Name -> [Rule] -> IO (Maybe [[[Rule]]])

Files

Language/Atom.hs view
@@ -1,3 +1,9 @@+{- | Atom is a Haskell DSL for designing hard realtime embedded programs.+     Based on conditional term rewriting, atom will compile+     a collection of atomic state transition rules+     to a C program with constant memory use and deterministic execution time.+-}+ module Language.Atom   ( module Language.Atom.Compile   , module Language.Atom.Common
Language/Atom/Code.hs view
@@ -13,7 +13,7 @@ import Language.Atom.Expressions  declareMemory :: UV -> String-declareMemory (UV id name init) = cType (constType init) ++ " " ++ e id ++ " = " ++ c ++ ";  /* " ++ name ++ " */\n"+declareMemory (UV id name (Local init)) = cType (constType init) ++ " " ++ e id ++ " = " ++ c ++ ";  /* " ++ name ++ " */\n"   where   c = case init of     CBool   c -> if c then "1" else "0" @@ -27,14 +27,15 @@     CWord64 c -> show c     CFloat  c -> show c     CDouble c -> show c+declareMemory (UV _ _ (External _)) = "" -declareUE :: String -> (UE, Int) -> String-declareUE d (ue, i) = case ue of+declareUE :: String -> (UE, String) -> String+declareUE d (ue, n) = case ue of   UVRef _              -> ""-  UConst (CBool True ) -> d ++ "const " ++ cType (ueType ue) ++ " " ++ e i ++ " = 1;\n"-  UConst (CBool False) -> d ++ "const " ++ cType (ueType ue) ++ " " ++ e i ++ " = 0;\n"-  UConst c             -> d ++ "const " ++ cType (ueType ue) ++ " " ++ e i ++ " = " ++ show c ++ ";\n"-  _                    -> d ++ cType (ueType ue) ++ " " ++ e i ++ ";\n"+  UConst (CBool True ) -> d ++ "const " ++ cType (ueType ue) ++ " " ++ n ++ " = 1;\n"+  UConst (CBool False) -> d ++ "const " ++ cType (ueType ue) ++ " " ++ n ++ " = 0;\n"+  UConst c             -> d ++ "const " ++ cType (ueType ue) ++ " " ++ n ++ " = " ++ show c ++ ";\n"+  _                    -> d ++             cType (ueType ue) ++ " " ++ n ++ ";\n"  cType :: Type -> String cType t = case t of@@ -50,17 +51,16 @@   Float  -> "float"   Double -> "double" -codeUE :: [(UE, Int)] -> String -> (UE, Int) -> String-codeUE ues d (ue, i) = case ue of+codeUE :: [(UE, String)] -> String -> (UE, String) -> String+codeUE ues d (ue, n) = case ue of   UConst _       -> ""   UVRef _        -> ""-  _              -> d ++ e i ++ " = " ++ basic operands ++ ";\n"+  _              -> d ++ n ++ " = " ++ basic operands ++ ";\n"   where   operands = map (fromJust . flip lookup ues) $ ueUpstream ue-  basic :: [Int] -> String+  basic :: [String] -> String   basic operands = case ue of     UVRef _              -> error "Code.ueStmt: should not get here."-    UCust _ c            -> c     UCast _ _            -> "(" ++ cType (ueType ue) ++ ") " ++ a     UConst _             -> error "Code.ueStmt: should not get here."     UAdd _ _             ->  a ++ " + " ++ b@@ -69,7 +69,7 @@     UDiv _ _             ->  a ++ " / " ++ b     UMod _ _             ->  a ++ " % " ++ b     UNot _               ->  "! " ++ a-    UAnd _               ->  drop 4 $ concat [ " && " ++ e a | a <- operands ]+    UAnd _               ->  drop 4 $ concat [ " && " ++ a | a <- operands ]     UBWNot _             ->  "~ " ++ a     UBWAnd _ _           ->  a ++ " & " ++ b     UBWOr  _ _           ->  a ++ " | " ++ b@@ -82,43 +82,60 @@     UB2F _               -> "*((float *) &" ++ a ++ ")"     UB2D _               -> "*((double *) &" ++ a ++ ")"     where-    a = e $ operands !! 0-    b = e $ operands !! 1-    c = e $ operands !! 2+    a = operands !! 0+    b = operands !! 1+    c = operands !! 2 -writeC :: Name -> String -> String -> String -> [[[Rule]]] -> [UV] -> IO ()-writeC name include preCode postCode periods uvs = do+writeC :: Name -> [[[Rule]]] -> [UV] -> IO ()+writeC name periods uvs = do   writeFile (name ++ ".c") c+  writeFile "CoverageData.hs" cov   where   c = unlines-    [ include-    , cType Word64 ++ " globalClock = 0;"+    [ cType Word64 ++ " __clock = 0;"+    , "const " ++ cType Word32 ++ " __coverage_len = " ++ show covLen ++ ";"+    , cType Word32 ++ " __coverage[" ++ show covLen ++ "] = {" ++ drop 2 (concat $ replicate covLen ", 0") ++ "};"+    , cType Word32 ++ " __coverage_index = 0;"     , concatMap declareMemory uvs     , concatMap (codeRule topo') $ concat $ concat periods     , "void " ++ name ++ "(void) {"-    , preCode     , concatMap codePeriod $ zip [1..] periods-    , postCode-    , "  globalClock = globalClock + 1;"+    , "  __clock = __clock + 1;"     , "}"     ] +  rules = concat $ concat periods++  cov = unlines+    [ "module CoverageData (coverageData) where"+    , ""+    , "-- | Encoding of rule coverage: (rule name, coverage array index, coverage bit)"+    , "coverageData :: [(String, (Int, Int))]"+    , "coverageData = " ++ show [ (ruleName r, (div (ruleId r) 32, mod (ruleId r) 32)) | r <- rules ]+    ]+   topo' = topo $ maximum (map (\ (UV i _ _) -> i) uvs) + 1+  covLen = 1 + div (maximum $ map ruleId rules) 32 -codeRule :: ([UE] -> [(UE, Int)]) -> Rule -> String+codeRule :: ([UE] -> [(UE, String)]) -> Rule -> String codeRule topo rule =    "/* " ++ show rule ++ " */\n" ++   "void r" ++ show (ruleId rule) ++ "(void) {\n" ++   concatMap (declareUE  "  ") ues ++   concatMap (codeUE ues "  ") ues +++  "  if (" ++ id (ruleEnable rule) ++ ") {\n" ++   concatMap codeAction (ruleActions rule) ++-  concatMap (\ (UV i _ _, ue) -> "  " ++ e i ++ " = " ++ e (id ue) ++ ";\n") (ruleAssigns rule) +++  "    __coverage[" ++ covWord ++ "] = __coverage[" ++ covWord ++ "] | (1 << " ++ covBit ++ ");\n" +++  "  }\n" +++  concatMap (\ (uv, ue) -> "  " ++ v uv ++ " = " ++ id ue ++ ";\n") (ruleAssigns rule) ++   "}\n\n"   where   ues = topo $ ruleEnable rule : snd (unzip (ruleAssigns rule)) ++ concat (snd (unzip (ruleActions rule)))   id ue = fromJust $ lookup ue ues   codeAction :: (([String] -> String), [UE]) -> String-  codeAction (f, args) = "  if (" ++ e (id (ruleEnable rule)) ++ ") " ++ f (map (e . id) args) ++ ";\n"+  codeAction (f, args) = "    " ++ f (map id args) ++ ";\n"+  covWord = show $ div (ruleId rule) 32+  covBit  = show $ mod (ruleId rule) 32  codePeriod :: (Int, [[Rule]]) -> String codePeriod (period, cycles) = concatMap (codeCycle period) $ zip [0..] cycles@@ -127,24 +144,28 @@ codeCycle period (cycle, _) | cycle >= period = error "Code.codeCycle" codeCycle _ (_, rules)      | null rules = "" codeCycle period (cycle, rules) =-  "  if (globalClock % " ++ show period ++ " == " ++ show cycle ++ ") {\n" +++  "  if (__clock % " ++ show period ++ " == " ++ show cycle ++ ") {\n" ++   concatMap (\ r -> "    r" ++ show (ruleId r) ++ "();  /* " ++ show r ++ " */\n") rules ++   "  }\n"  e :: Int -> String e i = "e" ++ show i +v :: UV -> String+v (UV i _ (Local _)) = e i+v (UV _ n (External _)) = n  -- | Topologically sorts a list of expressions and subexpressions.-topo :: Int -> [UE] -> [(UE, Int)]+topo :: Int -> [UE] -> [(UE, String)] topo start ues = reverse ues'   where   (_, ues') = foldl collect (start, []) ues-  collect :: (Int, [(UE, Int)]) -> UE -> (Int, [(UE, Int)])+  collect :: (Int, [(UE, String)]) -> UE -> (Int, [(UE, String)])   collect (n, ues) ue | any ((== ue) . fst) ues = (n, ues)   collect (n, ues) ue = case ue of-    UVRef (UV i _ _) -> (n,      (ue, i)  : ues )-    _              -> (n' + 1, (ue, n') : ues')+    UVRef (UV i _ (Local    _)) -> (n, (ue, e i) : ues)+    UVRef (UV _ a (External _)) -> (n, (ue, a)   : ues)+    _                -> (n' + 1, (ue, e n') : ues')       where       (n', ues') = foldl collect (n, ues) $ ueUpstream ue 
Language/Atom/Compile.hs view
@@ -12,24 +12,26 @@ import Language.Atom.Scheduling import Language.Atom.Elaboration import Language.Atom.Language hiding (Atom)-import Language.Atom.Verify+import Language.Atom.Verify ()  -- | Compiles an atom description to C.-compile :: Name -> String -> String -> String -> Atom () -> Int -> IO ()-compile name include preCode postCode atom depth = do+compile :: Name -> Atom () -> IO ()+compile name atom = do   r <- elaborate name atom   case r of     Nothing -> putStrLn "ERROR: Design rule checks failed." >> exitWith (ExitFailure 1)-    Just (rules, uvs, asserts) -> do-      r <- schedule rules+    Just (rules, uvs, _) -> do+      r <- schedule name rules       case r of         Nothing -> putStrLn "ERROR: Rule scheduling failed." >> exitWith (ExitFailure 1)         Just schedule -> do+          {-           when (depth > 0) $ do             putStrLn $ "Starting bounded model checking with depth " ++ show depth ++ "..."             v <- mapM (verify depth schedule uvs) asserts              when (not $ and v) $ putStrLn "ERROR: Verification failed." >> exitWith (ExitFailure 1)+          -}           putStrLn "Starting code generation..."           hFlush stdout-          writeC name include preCode postCode schedule uvs+          writeC name schedule uvs 
Language/Atom/Elaboration.hs view
@@ -12,6 +12,7 @@   , Path   , elaborate   , var+  , var'   , addName   ) where @@ -82,6 +83,11 @@   enableAssign :: (UV, UE) -> (UV, UE)   enableAssign (uv, ue) = (uv, umux enable ue $ UVRef uv) +reIdRules :: [Rule] -> [Rule]+reIdRules rules = map (\ r -> r { ruleId = fromJust $ lookup (ruleId r) ids } ) rules+  where+  ids = zip (map ruleId rules) [0..]+ buildAtom :: Global -> Name -> Atom a -> IO (a, (Global, AtomDB)) buildAtom g name atom = do   runStateT atom $ (g { gId = gId g + 1 }, AtomDB@@ -108,12 +114,15 @@   putStrLn "Starting atom elaboration..."   hFlush stdout   (_, (g, atomDB)) <- buildAtom (Global { gId = 0, gProbes = [], gUVs = [], gPeriod = 1, gAsserts = [] }) name atom-  let rules = elaborateRules (ubool True) atomDB+  let rules = reIdRules $ elaborateRules (ubool True) atomDB   mapM_ checkEnable rules   ok <- checkAssignConflicts atomDB   if not ok     then return Nothing-    else return $ Just (rules, sort $ gUVs g, gAsserts g)+    else do+      let uvs = sort $ gUVs g+      ruleGraph name rules uvs+      return $ Just (rules, uvs, gAsserts g)  checkEnable :: Rule -> IO () checkEnable rule | ruleEnable rule == ubool False = putStrLn $ "WARNING: Rule will never execute: " ++ show rule@@ -132,15 +141,23 @@   vars = fst $ unzip $ atomAssigns atom   vars' = nub vars --- | Generic variable declaration.+-- | Generic local variable declaration. var :: Name -> Const -> Atom (V a) var name const = do   name <- addName name   (g, atom) <- get-  let uv = UV (gId g) name const+  let uv = UV (gId g) name $ Local const   put (g { gId = gId g  + 1, gUVs =  uv : gUVs g }, atom)   return $ V uv +-- | Generic external variable declaration.+var' :: Name -> Type -> Atom (V a)+var' name t = do+  (g, atom) <- get+  let uv = UV (gId g) name $ External t+  put (g { gId = gId g  + 1, gUVs =  uv : gUVs g }, atom)+  return $ V uv+ addName :: Name -> Atom Name addName name = do   (g, atom) <- get@@ -149,4 +166,24 @@     else do       put (g, atom { atomNames = name : atomNames atom })       return $ atomName atom ++ "." ++ name++ruleGraph :: Name -> [Rule] -> [UV] -> IO ()+ruleGraph name rules uvs = do+  putStrLn $ "Writinig rule graph (" ++ name ++ ".dot)..."+  writeFile (name ++ ".dot") g+  --system $ "dot -o " ++ name ++ ".png -Tpng " ++ name ++ ".dot"+  return ()+  where+  g = unlines+    [ "digraph " ++ name ++ "{"+    , concat [ "  r" ++ show (ruleId r) ++ " [label = \"" ++ show r ++ "\" shape = ellipse];\n" | r <- rules ]+    , concat [ "  v" ++ show i ++ " [label = \"" ++ n ++ "\" shape = box];\n" | (UV i n _) <- uvs ]+    , concat [ "  r" ++ show (ruleId r) ++ " -> v" ++ show i ++ "\n" | r <- rules,  (UV i _ _, _) <- ruleAssigns r ]+    , concat [ "  v" ++ show i ++ " -> r" ++ show (ruleId r) ++ "\n" | r <- rules,  (UV i _ _) <- ruleUVRefs r ]+    , "}"+    ]++  ruleUVRefs r = nub $ concatMap uvSet ues+    where+    ues = ruleEnable r : snd (unzip (ruleAssigns r)) ++ concat (snd (unzip (ruleActions r))) 
+ Language/Atom/Example.hs view
@@ -0,0 +1,36 @@+-- | An example atom design.+module Language.Atom.Example+  ( compileExample+  , example+  ) where++import Language.Atom++-- | Invoke the atom compiler.+compileExample :: IO ()+compileExample = compile "example" example++-- | Example design introduces a unsigned 16-bit variable,+--   and declares two rules: one to increment the variable,+--   one to reset the variable back to zero when it hits 100.+example :: Atom ()+example = period 2 $ do   -- Set execution period as a factor of 2 of the base rate.++  -- A local state variable.+  count <- word64 "count" 0++  -- An external variable.+  reset <- bool' "reset"++  -- A rule to increment the count.+  atom "increment" $ do+    cond $ value count <. 100+    count <== value count + 1++  -- A rule to reset the count.+  atom "reset" $ do+    cond $ value count ==. 100+    cond $ value reset+    count <== 0++
Language/Atom/Expressions.hs view
@@ -5,6 +5,7 @@   , V     (..)   , UE    (..)   , UV    (..)+  , UVLocality (..)   , Expr  (..)   , Expression (..)   , Variable   (..)@@ -22,8 +23,6 @@   , FloatingE   , EqE   , OrdE-  -- * Custom Es-  , customDouble   -- * Constants   , true   , false@@ -166,15 +165,17 @@ data V a = V UV deriving Eq  -- | Unsigned variables.-data UV = UV Int String Const deriving Show+data UV = UV Int String UVLocality deriving Show instance Eq   UV where UV a _ _  == UV b _ _ = a == b instance Ord  UV where compare (UV a _ _) (UV b _ _) = compare a b +-- | UV locality.+data UVLocality = Local Const | External Type deriving Show+ -- | A typed expression. data E a where   VRef    :: V a -> E a   Const   :: a -> E a-  Cust    :: String -> E a   Cast    :: (NumE a, NumE b) => E a -> E b   Add     :: NumE a => E a -> E a -> E a   Sub     :: NumE a => E a -> E a -> E a@@ -205,7 +206,6 @@ data UE   = UVRef UV   | UConst Const-  | UCust  Type String   | UCast  Type UE   | UAdd   UE UE   | USub   UE UE@@ -442,10 +442,6 @@   bitSize  a = width a   isSigned a = signed a --- | Creates a custom E Double.-customDouble :: String -> E Double-customDouble c = Cust c- -- | True term. true :: E Bool true = Const True@@ -556,7 +552,6 @@ uvList :: UE -> [UV] uvList t = case t of   UVRef v      -> [v]-  UCust _ _    -> []   UCast _ a    -> uvList a   UConst _     -> []   UAdd a b     -> uvList a ++ uvList b@@ -579,13 +574,13 @@   UB2D a       -> uvList a  uvType :: UV -> Type-uvType (UV _ _ c) = constType c+uvType (UV _ _ (Local c))    = constType c+uvType (UV _ _ (External t)) = t  -- | The type of an UE. ueType :: UE -> Type ueType t = case t of   UVRef uvar -> uvType uvar-  UCust t _  -> t   UCast t _  -> t   UConst c   -> constType c   UAdd a _   -> ueType a@@ -611,7 +606,6 @@ ueUpstream :: UE -> [UE] ueUpstream t = case t of   UVRef _   -> []-  UCust _ _   -> []   UCast _ a   -> [a]   UConst _    -> []   UAdd a b    -> [a, b]@@ -637,7 +631,6 @@ ue t = case t of   VRef (V v) -> UVRef v   Const  a     -> UConst $ constant a-  Cust   a     -> UCust    tt a   Cast   a     -> UCast    tt (ue a)   Add    a b   -> UAdd     (ue a) (ue b)   Sub    a b   -> USub     (ue a) (ue b)@@ -760,7 +753,6 @@ balance :: UE -> UE balance ue = case ue of   UVRef _      -> ue-  UCust _ _    -> ue   UCast t a    -> UCast t (balance a)   UConst _     -> ue   UAdd a b     -> UAdd   (balance a) (balance b)
Language/Atom/Language.hs view
@@ -18,17 +18,29 @@   --, priority   -- * Variable Declarations   , var+  , var'   , bool+  , bool'   , int8+  , int8'   , int16+  , int16'   , int32+  , int32'   , int64+  , int64'   , word8+  , word8'   , word16+  , word16'   , word32+  , word32'   , word64+  , word64'   , float+  , float'   , double+  , double'   -- * Custom Actions   , action   -- * Assertions@@ -41,6 +53,8 @@   , liftIO   , path   , clock+  -- * Code Coverage+  , nextCoverage   ) where  import Control.Monad.State hiding (join)@@ -93,50 +107,94 @@   (_, atom) <- get   return $ atomName atom --- | Boolean variable declaration.+-- | Local boolean variable declaration. bool :: Name -> Bool -> Atom (V Bool) bool name init = var name $ CBool init --- | Int8 variable declaration.+-- | External boolean variable declaration.+bool' :: Name -> Atom (V Bool)+bool' name = var' name Bool++-- | Local int8 variable declaration. int8 :: Name -> Int8 -> Atom (V Int8) int8 name init = var name $ CInt8 init --- | Int16 variable declaration.+-- | External int8 variable declaration.+int8' :: Name -> Atom (V Int8)+int8' name = var' name Int8++-- | Local int16 variable declaration. int16 :: Name -> Int16 -> Atom (V Int16) int16 name init = var name $ CInt16 init --- | Int32 variable declaration.+-- | External int16 variable declaration.+int16' :: Name -> Atom (V Int16)+int16' name = var' name Int16++-- | Local int32 variable declaration. int32 :: Name -> Int32 -> Atom (V Int32) int32 name init = var name $ CInt32 init --- | Int64 variable declaration.+-- | External int32 variable declaration.+int32' :: Name -> Atom (V Int32)+int32' name = var' name Int32++-- | Local int64 variable declaration. int64 :: Name -> Int64 -> Atom (V Int64) int64 name init = var name $ CInt64 init --- | Word8 variable declaration.+-- | External int64 variable declaration.+int64' :: Name -> Atom (V Int64)+int64' name = var' name Int64++-- | Local word8 variable declaration. word8 :: Name -> Word8 -> Atom (V Word8) word8 name init = var name $ CWord8 init --- | Word16 variable declaration.+-- | External word8 variable declaration.+word8' :: Name -> Atom (V Word8)+word8' name = var' name Word8++-- | Local word16 variable declaration. word16 :: Name -> Word16 -> Atom (V Word16) word16 name init = var name $ CWord16 init --- | Word32 variable declaration.+-- | External word16 variable declaration.+word16' :: Name -> Atom (V Word16)+word16' name = var' name Word16++-- | Local word32 variable declaration. word32 :: Name -> Word32 -> Atom (V Word32) word32 name init = var name $ CWord32 init --- | Word64 variable declaration.+-- | External word32 variable declaration.+word32' :: Name -> Atom (V Word32)+word32' name = var' name Word32++-- | Local word64 variable declaration. word64 :: Name -> Word64 -> Atom (V Word64) word64 name init = var name $ CWord64 init --- | Float variable declaration.+-- | External word64 variable declaration.+word64' :: Name -> Atom (V Word64)+word64' name = var' name Word64++-- | Local float variable declaration. float :: Name -> Float -> Atom (V Float) float name init = var name $ CFloat init --- | Double variable declaration.+-- | External float variable declaration.+float' :: Name -> Atom (V Float)+float' name = var' name Float++-- | Local double variable declaration. double :: Name -> Double -> Atom (V Double) double name init = var name $ CDouble init +-- | External double variable declaration.+double' :: Name -> Atom (V Double)+double' name = var' name Double+ -- | Declares an action. action :: ([String] -> String) -> [UE] -> Atom () action f ues = do@@ -202,5 +260,11 @@  -- | Reference to the 64-bit free running clock. clock :: E Word64-clock = Cust "globalClock"+clock = value (V (UV (-1) "__clock" (External Word64)))++-- | Rule coverage information.  (current coverage index, coverage data)+nextCoverage :: Atom (E Word32, E Word32)+nextCoverage = do+  action (\_ -> "__coverage_index = (__coverage_index + 1) % __coverage_len") []+  return (value (V (UV (-2) "__coverage_index" (External Word32))), value (V (UV (-3) "__coverage[__coverage_index]" (External Word32)))) 
Language/Atom/Scheduling.hs view
@@ -11,12 +11,12 @@ import System.IO import Text.Printf -schedule :: [Rule] -> IO (Maybe [[[Rule]]])-schedule rules = do+schedule :: Name -> [Rule] -> IO (Maybe [[[Rule]]])+schedule name rules = do   putStrLn "Starting rule scheduling..."   hFlush stdout-  putStrLn "Writing scheduling report: schedule.log"-  writeFile "schedule.log" $ reportSchedule periods+  putStrLn $ "Writing scheduling report (" ++ name ++ ".rpt)..."+  writeFile (name ++ ".rpt") $ reportSchedule periods   hFlush stdout   return $ Just periods   where
Language/Atom/Verify.hs view
@@ -68,7 +68,8 @@ initialize uvs = vars uvs 0 ++ concatMap initialize uvs   where   initialize :: UV -> String-  initialize uv@(UV _ _ c) = "(assert (= " ++ uvName 0 uv ++ " " ++ const c ++ "))\n"+  initialize uv@(UV _ _ (Local c)) = "(assert (= " ++ uvName 0 uv ++ " " ++ const c ++ "))\n"+  initialize (UV _ _ (External _)) = ""   const :: Const -> String   const c = case c of     CBool   c -> if c then "true" else "false" 
+ RELEASE-NOTES view
@@ -0,0 +1,11 @@+atom 0.0.2    04/26/2009++- Disabled Yices bounded model checking.  Removed search depth compile argument.+- Removed include, preCode, and postCode compile arguments.+- Added external variable declations (bool', word32', etc).  Removed Cust expressions.+- Generates dot file to display rule-variable relationships.+- Added hooks for rule execution coverage.++atom 0.0.1    04/22/2009++- Initial cabal release.
atom.cabal view
@@ -1,5 +1,5 @@ Name:           atom-Version:        0.0.1+Version:        0.0.2 Synopsis:       A DSL for embedded hard realtime applications. Description:    Atom is a Haskell DSL for designing hard realtime embedded programs.                 Based on conditional term rewriting, atom will compile@@ -13,6 +13,7 @@ Build-Type:     Simple Cabal-Version:  >= 1.2.3 Extra-Source-Files:+  RELEASE-NOTES  Library   Build-Depends:   base, mtl, process@@ -22,6 +23,7 @@     Language.Atom.Common,     Language.Atom.Compile,     Language.Atom.Elaboration,+    Language.Atom.Example,     Language.Atom.Expressions,     Language.Atom.Language,     Language.Atom.Scheduling,