atom 0.1.4 → 1.0.0

raw patch · 10 files changed

+147/−151 lines, 10 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +1/−3
• Language/Atom.hs +2/−2
• Language/Atom/Code.hs +66/−80
• Language/Atom/Compile.hs +2/−5
• Language/Atom/Elaboration.hs +29/−19
• Language/Atom/Example.hs +3/−3
• Language/Atom/Language.hs +17/−18
• Language/Atom/Unit.hs +14/−19
• RELEASE-NOTES +11/−0
• atom.cabal +2/−2

@@ -1,6 +1,4 @@-Copyright (c) Tom Hawkins 2007-2009--Contributions from John Van Enk, Brian Lewis, Lee Pike+Copyright (c) Tom Hawkins 2007-2010  All rights reserved. 

@@ -14,11 +14,11 @@   , module Language.Atom.Compile   , module Language.Atom.Common   , module Language.Atom.Language-  , module Language.Atom.Unit+  -- , module Language.Atom.Unit   ) where  import Language.Atom.Code import Language.Atom.Compile import Language.Atom.Common import Language.Atom.Language-import Language.Atom.Unit+-- import Language.Atom.Unit

@@ -3,16 +3,12 @@   ( Config (..)   , writeC   , defaults-  , cTypes-  , c99Types+  , cType   , RuleCoverage   ) where -import Data.Char import Data.List import Data.Maybe-import Data.Function-import System.IO import Text.Printf  import Language.Atom.Analysis@@ -23,19 +19,19 @@ -- | C code configuration parameters. data Config = Config   { cFuncName     :: String                                                  -- ^ Alternative primary function name.  Leave empty to use compile name.-  , cType         :: Type -> String                                          -- ^ C type naming rules.+  , cStateName    :: String                                                  -- ^ Name of state variable structure.  Default: state   , cCode         :: [Name] -> [Name] -> [(Name, Type)] -> (String, String)  -- ^ Custom C code to insert above and below, given assertion names, coverage names, and probe names and types.   , cRuleCoverage :: Bool                                                    -- ^ Enable rule coverage tracking.   , cAssert       :: Bool                                                    -- ^ Enable assertions and functional coverage.-  , cAssertName   :: String                                                  -- ^ Name of assertion function.  Type: void assert(int, cType Bool, cType Word64);-  , cCoverName    :: String                                                  -- ^ Name of coverage function.  Type: void cover(int, cType Bool, cType Word64);+  , cAssertName   :: String                                                  -- ^ Name of assertion function.  Type: void assert(int, bool, uint64_t);+  , cCoverName    :: String                                                  -- ^ Name of coverage function.  Type: void cover(int, bool, uint64_t);   }  -- | Default C code configuration parameters (default function name, no pre/post code, ANSI C types). defaults :: Config defaults = Config   { cFuncName     = ""-  , cType         = cTypes+  , cStateName    = "state"   , cCode         = \ _ _ _ -> ("", "")   , cRuleCoverage = True   , cAssert       = True@@ -45,37 +41,24 @@  showConst :: Const -> String showConst c = case c of-  CBool   c -> if c then "1" else "0"-  CInt8   c -> show c-  CInt16  c -> show c-  CInt32  c -> show c ++ "L"-  CInt64  c -> show c ++ "LL"-  CWord8  c -> show c-  CWord16 c -> show c-  CWord32 c -> show c ++ "UL"-  CWord64 c -> show c ++ "ULL"-  CFloat  c -> show c-  CDouble c -> show c+  CBool True  -> "true"+  CBool False -> "false"+  CInt8   a   -> show a+  CInt16  a   -> show a+  CInt32  a   -> show a ++ "L"+  CInt64  a   -> show a ++ "LL"+  CWord8  a   -> show a+  CWord16 a   -> show a+  CWord32 a   -> show a ++ "UL"+  CWord64 a   -> show a ++ "ULL"+  CFloat  a   -> show a ++ "F"+  CDouble a   -> show a --- | ANSI C type naming rules.-cTypes :: Type -> String-cTypes t = case t of-  Bool   -> "unsigned char"-  Int8   -> "signed char"-  Int16  -> "signed short"-  Int32  -> "signed long"-  Int64  -> "signed long long"-  Word8  -> "unsigned char"-  Word16 -> "unsigned short"-  Word32 -> "unsigned long"-  Word64 -> "unsigned long long"-  Float  -> "float"-  Double -> "double"  -- | C99 type naming rules.-c99Types :: Type -> String-c99Types t = case t of-  Bool   -> "uint8_t"+cType :: Type -> String+cType t = case t of+  Bool   -> "bool"   Int8   -> "int8_t"   Int16  -> "int16_t"   Int32  -> "int32_t"@@ -88,16 +71,16 @@   Double -> "double"  codeUE :: Config -> [(UE, String)] -> String -> (UE, String) -> String-codeUE config ues d (ue, n) = d ++ cType config (typeOf ue) ++ " " ++ n ++ " = " ++ basic operands ++ ";\n"+codeUE config ues d (ue, n) = d ++ cType (typeOf ue) ++ " " ++ n ++ " = " ++ basic operands ++ ";\n"   where   operands = map (fromJust . flip lookup ues) $ ueUpstream ue   basic :: [String] -> String   basic operands = concat $ case ue of-    UVRef (UV i n _)                 -> ["__v", show i, " /* ", n, " */ "]-    UVRef (UVArray (UA i n _) _)     -> ["__a", show i, "[", a, "] /* ", n, " */ "]+    UVRef (UV _ n _)                 -> [cStateName config, ".", n]+    UVRef (UVArray (UA _ n _) _)     -> [cStateName config, ".", n, "[", a, "]"]     UVRef (UVArray (UAExtern n _) _) -> [n, "[", a, "]"]     UVRef (UVExtern n _)             -> [n]-    UCast _ _            -> ["(", cType config (typeOf ue), ") ", a]+    UCast _ _            -> ["(", cType (typeOf ue), ") ", a]     UConst c             -> [showConst c]     UAdd _ _             -> [a, " + ", b]     USub _ _             -> [a, " - ", b]@@ -118,31 +101,34 @@     UB2F _               -> ["*((", ct Float , " *) &(", a, "))"]     UB2D _               -> ["*((", ct Double, " *) &(", a, "))"]     where-    ct = cType config+    ct = cType     a = head operands     b = operands !! 1     c = operands !! 2  type RuleCoverage = [(Name, Int, Int)] -writeC :: Name -> Config -> [Rule] -> Schedule -> [UV] -> [UA] -> [Name] -> [Name] -> [(Name, Type)] -> IO RuleCoverage-writeC name config rules schedule uvs uas assertionNames coverageNames probeNames = do+writeC :: Name -> Config -> StateHierarchy -> [Rule] -> Schedule -> [Name] -> [Name] -> [(Name, Type)] -> IO RuleCoverage+writeC name config state rules schedule assertionNames coverageNames probeNames = do   writeFile (name ++ ".c") c+  writeFile (name ++ ".h") h   return [ (ruleName r, div (ruleId r) 32, mod (ruleId r) 32) | r <- rules' ]   where   (preCode, postCode) = cCode config assertionNames coverageNames probeNames   c = unlines-    [ preCode+    [ "#include <stdbool.h>"+    , "#include <stdint.h>"     , ""-    , "static " ++ cType config Word64 ++ " __global_clock = 0;"-    , codeIf (cRuleCoverage config) $ "static const " ++ cType config Word32 ++ " __coverage_len = " ++ show covLen ++ ";"-    , codeIf (cRuleCoverage config) $ "static " ++ cType config Word32 ++ " __coverage[" ++ show covLen ++ "] = {" ++ (concat $ intersperse ", " $ replicate covLen "0") ++ "};"-    , codeIf (cRuleCoverage config) $ "static " ++ cType config Word32 ++ " __coverage_index = 0;"-    , concatMap (declUV config) uvs-    , concatMap (declUA config) uas+    , preCode+    , ""+    , "static " ++ cType Word64 ++ " __global_clock = 0;"+    , codeIf (cRuleCoverage config) $ "static const " ++ cType Word32 ++ " __coverage_len = " ++ show covLen ++ ";"+    , codeIf (cRuleCoverage config) $ "static " ++ cType Word32 ++ " __coverage[" ++ show covLen ++ "] = {" ++ (concat $ intersperse ", " $ replicate covLen "0") ++ "};"+    , codeIf (cRuleCoverage config) $ "static " ++ cType Word32 ++ " __coverage_index = 0;"+    , declState True $ StateHierarchy (cStateName config) [state]     , concatMap (codeRule config) rules'     , codeAssertionChecks config assertionNames coverageNames rules-    , "void " ++ (if null (cFuncName config) then name else cFuncName config) ++ "(void) {"+    , "void " ++ funcName ++ "() {"     , concatMap (codePeriodPhase config) schedule     , "  __global_clock = __global_clock + 1;"     , "}"@@ -150,6 +136,17 @@     , postCode     ] +  h = unlines+    [ "#include <stdbool.h>"+    , "#include <stdint.h>"+    , ""+    , "void " ++ funcName ++ "();"+    , ""+    , declState False $ StateHierarchy (cStateName config) [state]+    ]++  funcName = if null (cFuncName config) then name else cFuncName config+   rules' :: [Rule]   rules' = concat [ r | (_, _, r) <- schedule ] @@ -158,35 +155,24 @@ codeIf :: Bool -> String -> String codeIf a b = if a then b else "" -declUA :: Config -> UA -> String-declUA _ (UAExtern _ _) = error "declUA"-declUA config ua@(UA i n init) = concat ["static ", cType config (typeOf ua), " __a", show i, "[", show (length init), "] = {", intercalate "," (map formatConst init), "};  /* ", n, " */\n"]--declUV :: Config -> UV -> String-declUV _ (UVArray _ _)  = error "declUV"-declUV _ (UVExtern _ _) = error "declUV"-declUV config (UV i n init) = concat ["static ", cType config (typeOf init), " __v", show i, " = ", formatConst init, ";  /* ", n, " */\n"]+declState :: Bool -> StateHierarchy -> String+declState define a = (if define then "" else "extern ") ++ init (init (f1 "" a)) ++ (if define then " =\n" ++ f2 "" a else "") ++ ";\n"+  where+  f1 i a = case a of+    StateHierarchy name items -> i ++ "struct {  /* " ++ name ++ " */\n" ++ concatMap (f1 ("  " ++ i)) items ++ i ++ "} " ++ name ++ ";\n"+    StateVariable  name c     -> i ++ cType (typeOf c) ++ " " ++ name ++ ";\n"+    StateArray     name c     -> i ++ cType (typeOf $ head c) ++ " " ++ name ++ "[" ++ show (length c) ++ "];\n" -formatConst :: Const -> String-formatConst c = case c of-  CBool True  -> "1"-  CBool False -> "0"-  CInt8   a   -> show a-  CInt16  a   -> show a-  CInt32  a   -> show a ++ "L"-  CInt64  a   -> show a ++ "LL"-  CWord8  a   -> show a-  CWord16 a   -> show a-  CWord32 a   -> show a ++ "UL"-  CWord64 a   -> show a ++ "ULL"-  CFloat  a   -> show a ++ "F"-  CDouble a   -> show a+  f2 i a = case a of+    StateHierarchy name items -> i ++ "{  /* " ++ name ++ " */\n" ++ intercalate ",\n" (map (f2 ("  " ++ i)) items) ++ "\n" ++ i ++ "}"+    StateVariable  name c     -> i ++ "/* " ++ name ++ " */  " ++ showConst c+    StateArray     name c     -> i ++ "/* " ++ name ++ " */  {" ++ intercalate ", " (map showConst c) ++ "}"  codeRule :: Config -> Rule -> String codeRule config rule@(Rule _ _ _ _ _ _ _) =   "/* " ++ show rule ++ " */\n" ++-  "static void __r" ++ show (ruleId rule) ++ "(void) {\n" ++-  concatMap (codeUE    config ues "  ") ues +++  "static void __r" ++ show (ruleId rule) ++ "() {\n" +++  concatMap (codeUE config ues "  ") ues ++   "  if (" ++ id (ruleEnable rule) ++ ") {\n" ++   concatMap codeAction (ruleActions rule) ++   codeIf (cRuleCoverage config) ("    __coverage[" ++ covWord ++ "] = __coverage[" ++ covWord ++ "] | (1 << " ++ covBit ++ ");\n") ++@@ -207,8 +193,8 @@   codeAssign (uv, ue) = concat ["  ", lh, " = ", id ue, ";\n"]     where     lh = case uv of-      UV i n _                     -> concat ["__v", show i, " /* ", n, " */"]-      UVArray (UA i n _)     index -> concat ["__a", show i, "[", id index, "] /* ", n, " */"]+      UV _ n _                     -> concat [cStateName config, ".", n]+      UVArray (UA _ n _)     index -> concat [cStateName config, ".", n, "[", id index, "]"]       UVArray (UAExtern n _) index -> concat [n, "[", id index, "]"]       UVExtern n _                 -> n @@ -216,7 +202,7 @@  codeAssertionChecks :: Config -> [Name] -> [Name] -> [Rule] -> String codeAssertionChecks config assertionNames coverageNames rules = codeIf (cAssert config) $-  "static void __assertion_checks(void) {\n" +++  "static void __assertion_checks() {\n" ++   concatMap (codeUE config ues "  ") ues ++   concat [ "  if (" ++ id enable ++ ") " ++ cAssertName config ++ "(" ++ assertionId name ++ ", " ++ id check ++ ", __global_clock);\n" | Assert name enable check <- rules ] ++   concat [ "  if (" ++ id enable ++ ") " ++ cCoverName  config ++ "(" ++ coverageId  name ++ ", " ++ id check ++ ", __global_clock);\n" | Cover  name enable check <- rules ] ++@@ -232,7 +218,7 @@ codePeriodPhase :: Config -> (Int, Int, [Rule]) -> String codePeriodPhase config (period, phase, rules) = unlines   [ printf "  {"-  , printf "    static %s __scheduling_clock = %i;" (cType config clockType) phase+  , printf "    static %s __scheduling_clock = %i;" (cType clockType) phase   , printf "    if (__scheduling_clock == 0) {"   , intercalate "\n" $ map callRule rules   , printf "      __scheduling_clock = %i;" (period - 1)

@@ -5,10 +5,7 @@   , Schedule   ) where -import Control.Monad.State hiding (join)-import Data.Maybe import System.Exit-import System.IO  import Language.Atom.Code import Language.Atom.Scheduling@@ -21,8 +18,8 @@   r <- elaborate name atom   case r of     Nothing -> putStrLn "ERROR: Design rule checks failed." >> exitWith (ExitFailure 1)-    Just (rules, uvs, uas, assertionNames, coverageNames, probeNames) -> do+    Just (state, rules, assertionNames, coverageNames, probeNames) -> do       let schedule' = schedule rules-      ruleCoverage <- writeC name config rules schedule' uvs uas assertionNames coverageNames probeNames+      ruleCoverage <- writeC name config state rules schedule' assertionNames coverageNames probeNames       return (schedule', ruleCoverage, assertionNames, coverageNames, probeNames) 

@@ -5,6 +5,7 @@   , AtomDB     (..)   , Global     (..)   , Rule       (..)+  , StateHierarchy (..)   , buildAtom   -- * Type Aliases and Utilities   , UID@@ -22,13 +23,10 @@   , allUEs   ) where -import Control.Monad import Control.Monad.Trans import Data.Function (on) import Data.List-import Data.Maybe import Language.Atom.Expressions-import System.IO  type UID = Int @@ -42,8 +40,7 @@   { gRuleId  :: Int   , gVarId   :: Int   , gArrayId :: Int-  , gVars    :: [UV]-  , gArrays  :: [UA]+  , gState   :: [StateHierarchy]   , gProbes  :: [(String, UE)]   , gPeriod  :: Int   , gPhase   :: Int@@ -84,6 +81,11 @@     , ruleCover     :: UE     } +data StateHierarchy+  = StateHierarchy Name [StateHierarchy]+  | StateVariable  Name Const+  | StateArray     Name [Const]+ instance Show AtomDB where show = atomName instance Eq   AtomDB where (==) = (==) `on` atomId instance Ord  AtomDB where compare a b = compare (atomId a) (atomId b)@@ -167,9 +169,9 @@ -- data Relation = Higher UID | Lower UID deriving (Show, Eq)  -- | Given a top level name and design, elaborates design and returns a design database.-elaborate :: Name -> Atom () -> IO (Maybe ([Rule], [UV], [UA], [Name], [Name], [(Name, Type)]))+elaborate :: Name -> Atom () -> IO (Maybe (StateHierarchy, [Rule], [Name], [Name], [(Name, Type)])) elaborate name atom = do-  (_, (g, atomDB)) <- buildAtom Global { gRuleId = 0, gVarId = 0, gArrayId = 0, gVars = [], gArrays = [], gProbes = [], gPeriod = 1, gPhase  = 0 } name atom+  (_, (g, atomDB)) <- buildAtom Global { gRuleId = 0, gVarId = 0, gArrayId = 0, gState = [], gProbes = [], gPeriod = 1, gPhase  = 0 } name atom   let rules = reIdRules 0 $ elaborateRules (ubool True) atomDB       coverageNames  = [ name | Cover  name _ _ <- rules ]       assertionNames = [ name | Assert name _ _ <- rules ]@@ -181,9 +183,15 @@     else do       mapM_ checkEnable rules       ok <- mapM checkAssignConflicts rules-      return (if and ok then Just (rules, gVars g, gArrays g, assertionNames, coverageNames, probeNames) else Nothing)-+      return (if and ok then Just (trimState $ StateHierarchy name $ gState g, rules, assertionNames, coverageNames, probeNames) else Nothing) +trimState :: StateHierarchy -> StateHierarchy+trimState a = case a of+  StateHierarchy name items -> StateHierarchy name $ filter f $ map trimState items+  a -> a+  where+  f (StateHierarchy _ []) = False+  f _ = True   -- | Checks that a rule will not be trivially disabled.@@ -232,29 +240,31 @@ -- | Generic local variable declaration. var :: Expr a => Name -> a -> Atom (V a) var name init = do-  name <- addName name+  name' <- addName name   (g, atom) <- get-  let uv = UV (gVarId g) name (constant init)-  put (g { gVarId = gVarId g + 1, gVars = uv : gVars g }, atom)+  let uv = UV (gVarId g) name' c+      c = constant init+  put (g { gVarId = gVarId g + 1, gState = gState g ++ [StateVariable name c] }, atom)   return $ V uv  -- | Generic external variable declaration.-var' :: Name -> Type -> Atom (V a)-var' name t = return $ V $ UVExtern name t+var' :: Name -> Type -> V a+var' name t = V $ UVExtern name t  -- | Generic array declaration. array :: Expr a => Name -> [a] -> Atom (A a) array name [] = error $ "ERROR: arrays can not be empty: " ++ name array name init = do-  name <- addName name+  name' <- addName name   (g, atom) <- get-  let ua = UA (gArrayId g) name (map constant init)-  put (g { gArrayId = gArrayId g + 1, gArrays = ua : gArrays g}, atom)+  let ua = UA (gArrayId g) name' c+      c = map constant init+  put (g { gArrayId = gArrayId g + 1, gState = gState g ++ [StateArray name c] }, atom)   return $ A ua  -- | Generic external array declaration.-array' :: Expr a => Name -> Type -> Atom (A a)-array' name t = return $ A $ UAExtern  name t+array' :: Expr a => Name -> Type -> A a+array' name t = A $ UAExtern  name t  addName :: Name -> Atom Name addName name = do

@@ -47,13 +47,13 @@ example = do    -- External reference to value A.-  a <- word32' "a"+  let a = word32' "a"    -- External reference to value B.-  b <- word32' "b"+  let b = word32' "b"    -- The external running flag.-  running <- bool' "running"+  let running = bool' "running"    -- A rule to modify A.   atom "a_minus_b" $ do

@@ -64,7 +64,6 @@ import Control.Monad import Control.Monad.Trans import Data.Int-import Data.List import Data.Word  import Language.Atom.Elaboration hiding (Atom)@@ -79,10 +78,10 @@ -- | Creates a hierarchical node, where each node could be a atomic rule. atom :: Name -> Atom a -> Atom a atom name design = do-  name <- addName name-  (g, parent) <- get-  (a, (g, child)) <- liftIO $ buildAtom g name design-  put (g, parent { atomSubs = atomSubs parent ++ [child] })+  name' <- addName name+  (g1, parent) <- get+  (a, (g2, child)) <- liftIO $ buildAtom g1 { gState = [] } name' design+  put (g2 { gState = gState g1 ++ [StateHierarchy name $ gState g2] }, parent { atomSubs = atomSubs parent ++ [child] })   return a  -- | Defines the period of execution of sub rules as a factor of the base rate of the system.@@ -136,7 +135,7 @@ bool = var  -- | External boolean variable declaration.-bool' :: Name -> Atom (V Bool)+bool' :: Name -> V Bool bool' name = var' name Bool  -- | Local int8 variable declaration.@@ -144,7 +143,7 @@ int8 = var  -- | External int8 variable declaration.-int8' :: Name -> Atom (V Int8)+int8' :: Name -> V Int8 int8' name = var' name Int8  -- | Local int16 variable declaration.@@ -152,7 +151,7 @@ int16 = var  -- | External int16 variable declaration.-int16' :: Name -> Atom (V Int16)+int16' :: Name -> V Int16 int16' name = var' name Int16  -- | Local int32 variable declaration.@@ -160,7 +159,7 @@ int32 = var  -- | External int32 variable declaration.-int32' :: Name -> Atom (V Int32)+int32' :: Name -> V Int32 int32' name = var' name Int32  -- | Local int64 variable declaration.@@ -168,7 +167,7 @@ int64 = var  -- | External int64 variable declaration.-int64' :: Name -> Atom (V Int64)+int64' :: Name -> V Int64 int64' name = var' name Int64  -- | Local word8 variable declaration.@@ -176,7 +175,7 @@ word8 = var  -- | External word8 variable declaration.-word8' :: Name -> Atom (V Word8)+word8' :: Name -> V Word8 word8' name = var' name Word8  -- | Local word16 variable declaration.@@ -184,7 +183,7 @@ word16 = var  -- | External word16 variable declaration.-word16' :: Name -> Atom (V Word16)+word16' :: Name -> V Word16 word16' name = var' name Word16  -- | Local word32 variable declaration.@@ -192,7 +191,7 @@ word32 = var  -- | External word32 variable declaration.-word32' :: Name -> Atom (V Word32)+word32' :: Name -> V Word32 word32' name = var' name Word32  -- | Local word64 variable declaration.@@ -200,7 +199,7 @@ word64 = var  -- | External word64 variable declaration.-word64' :: Name -> Atom (V Word64)+word64' :: Name -> V Word64 word64' name = var' name Word64  -- | Local float variable declaration.@@ -208,7 +207,7 @@ float = var  -- | External float variable declaration.-float' :: Name -> Atom (V Float)+float' :: Name -> V Float float' name = var' name Float  -- | Local double variable declaration.@@ -216,7 +215,7 @@ double = var  -- | External double variable declaration.-double' :: Name -> Atom (V Double)+double' :: Name -> V Double double' name = var' name Double  -- | Declares an action.@@ -283,13 +282,13 @@  -- | Reference to the 64-bit free running clock. clock :: E Word64-clock = value $ V $ UVExtern "__global_clock" Word64+clock = value $ word64' "__global_clock"  -- | Rule coverage information.  (current coverage index, coverage data) nextCoverage :: Atom (E Word32, E Word32) nextCoverage = do   action (const "__coverage_index = (__coverage_index + 1) % __coverage_len") []-  return (value $ V $ UVExtern "__coverage_index" Word32, value $ V $ UVExtern "__coverage[__coverage_index]" Word32)+  return (value $ word32' "__coverage_index", value $ word32' "__coverage[__coverage_index]")   -- | An assertions checks that an E Bool is true.  Assertions are checked between the execution of every rule.

@@ -76,6 +76,8 @@   putStrLn ""   putStrLn $ (if passingTests /= totalTests then "RED" else if not $ null unHitCoverage then "YELLOW" else "GREEN") ++ " LIGHT"   putStrLn ""+  when (passingTests /= totalTests) $ exitWith $ ExitFailure 2+  when (not $ null unHitCoverage)   $ exitWith $ ExitFailure 1  reportResult :: Int -> (Name, Bool, Int, a, b) -> IO () reportResult m (name, pass, cycles, _, _) =@@ -154,25 +156,18 @@ printFloatingE name value = action (\ [v] -> "printf(\"" ++ name ++ ": %f\\n\", " ++ v ++ ")") [ue value]  -class Expr a => Random a where random :: Atom (E a)+class Expr a => Random a where random :: E a -instance Random Bool where-  random = do-    r <- random32-    return $ (1 .&. r) ==. 1-instance Random Word8  where random = random32 >>= (return . Cast)-instance Random Word16 where random = random32 >>= (return . Cast)-instance Random Word32 where random = random32-instance Random Word64 where-  random = do-    a <- random32-    b <- random32  -- XXX Will repeated "rand()" variables work?-    return $ Cast a .|. shiftL (Cast b) 32-instance Random Int8  where random = random32 >>= (return . Cast)-instance Random Int16 where random = random32 >>= (return . Cast)-instance Random Int32 where random = random32 >>= (return . Cast)-instance Random Int64 where random = (random :: Atom (E Word64)) >>= (return . Cast)+instance Random Bool   where random = (1 .&. random32) ==. 1+instance Random Word8  where random = Cast random32+instance Random Word16 where random = Cast random32+instance Random Word32 where random = Cast random32+instance Random Word64 where random = Cast random32 .|. shiftL (Cast random32) 32+instance Random Int8   where random = Cast random32+instance Random Int16  where random = Cast random32+instance Random Int32  where random = Cast random32+instance Random Int64  where random = Cast (random :: E Word64) -random32 :: Atom (E Word32)-random32 = word32' "rand()" >>= (return . value)+random32 :: E Word32+random32 = value $ word32' "rand()" 

@@ -1,3 +1,14 @@+atom 1.0.0    02/13/2010++- Set C99 types (stdbool.h, stdint.h).  Removed cType from code configuration.+- Removed (void) argument in generated functions.+- Moved variables and arrays into a single hierarchical structure to provide direct access to Atom state variables from C code.+- Pulled var' and friends (bool', word8', int64', etc.) out of the Atom monad.+- Pulled Unit.random out of the Atom monad.+- Unit.runTests returns exit codes 1 for YELLOW light and 2 for RED LIGHT.+- Added cStateName code configuration for naming state structure.  Defaults to "state".+- Generates header file to declare primary function and state structure.+ atom 0.1.4    12/16/2009  - Added 'call' function. 

@@ -1,5 +1,5 @@ name:    atom-version: 0.1.4+version: 1.0.0  category: Language @@ -33,7 +33,7 @@  library     build-depends:-        base       >= 4       && < 5,+        base       >= 4.2     && < 5,         mtl        >= 1.1.0.1 && < 1.2,         process    >= 1.0.1.1 && < 1.2