atom 1.0.9 → 1.0.10

raw patch · 6 files changed

+495/−432 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Language/Atom/Code.hs +80/−66
• Language/Atom/Elaboration.hs +3/−4
• Language/Atom/Expressions.hs +194/−161
• Language/Atom/UeMap.hs +210/−200
• RELEASE-NOTES +7/−0
• atom.cabal +1/−1

@@ -19,7 +19,7 @@ import Language.Atom.Elaboration import Language.Atom.Expressions hiding (typeOf) import qualified Language.Atom.Expressions as E-import Language.Atom.Scheduling +import Language.Atom.Scheduling import Language.Atom.UeMap  -- | C code configuration parameters.@@ -31,8 +31,14 @@    , cCode         :: [Name] -> [Name] -> [(Name, Type)]                       -> (String, String)  -- ^ Custom C code to insert above-                                           -- and below, given assertion names,-                                           -- coverage names, and probe names+                                           -- and below the functions, given+                                           -- assertion names, coverage names,+                                           -- and probe names and types.+  , hCode         :: [Name] -> [Name] -> [(Name, Type)]+                      -> (String, String)  -- ^ Custom C code to insert above+                                           -- and below the state definition+                                           -- in the header file, given assertion+                                           -- names, coverage names, and probe names                                            -- and types.   , cRuleCoverage :: Bool -- ^ Enable rule coverage tracking.   , cAssert       :: Bool -- ^ Enable assertions and functional coverage.@@ -74,6 +80,7 @@   { cFuncName     = ""   , cStateName    = "state"   , cCode         = \ _ _ _ -> ("", "")+  , hCode         = \ _ _ _ -> ("", "")   , cRuleCoverage = True   , cAssert       = True   , cAssertName   = "assert"@@ -116,7 +123,7 @@   Double -> "double"  codeUE :: UeMap -> Config -> [(Hash, String)] -> String -> (Hash, String) -> String-codeUE mp config ues d (ue, n) = +codeUE mp config ues d (ue, n) =   d ++ cType (typeOf ue mp) ++ " " ++ n ++ " = " ++ basic ++ ";\n"   where   operands = map (fromJust . flip lookup ues) $ ueUpstream ue mp@@ -126,42 +133,44 @@     MUVRef (MUVArray (UA _ n _) _)     -> [cStateName config, ".", n, "[", a, "]"]     MUVRef (MUVArray (UAExtern n _) _) -> [n, "[", a, "]"]     MUVRef (MUVExtern n _)             -> [n]-    MUCast _ _            -> ["(", cType (typeOf ue mp), ") ", a]-    MUConst c             -> [showConst c]-    MUAdd _ _             -> [a, " + ", b]-    MUSub _ _             -> [a, " - ", b]-    MUMul _ _             -> [a, " * ", b]-    MUDiv _ _             -> [a, " / ", b]-    MUMod _ _             -> [a, " % ", b]-    MUNot _               -> ["! ", a]-    MUAnd _               -> intersperse " && " operands-    MUBWNot _             -> ["~ ", a]-    MUBWAnd _ _           -> [a, " & ", b]-    MUBWOr  _ _           -> [a, " | ", b]-    MUShift _ n           -> (if n >= 0 then [a, " << ", show n] else [a, " >> ", show (negate n)])-    MUEq  _ _             -> [a, " == ", b]-    MULt  _ _             -> [a, " < " , b]-    MUMux _ _ _           -> [a, " ? " , b, " : ", c]-    MUF2B _               -> ["*((", ct Word32, " *) &(", a, "))"]-    MUD2B _               -> ["*((", ct Word64, " *) &(", a, "))"]-    MUB2F _               -> ["*((", ct Float , " *) &(", a, "))"]-    MUB2D _               -> ["*((", ct Double, " *) &(", a, "))"]+    MUCast _ _     -> ["(", cType (typeOf ue mp), ") ", a]+    MUConst c      -> [showConst c]+    MUAdd _ _      -> [a, " + ", b]+    MUSub _ _      -> [a, " - ", b]+    MUMul _ _      -> [a, " * ", b]+    MUDiv _ _      -> [a, " / ", b]+    MUMod _ _      -> [a, " % ", b]+    MUNot _        -> ["! ", a]+    MUAnd _        -> intersperse " && " operands+    MUBWNot _      -> ["~ ", a]+    MUBWAnd  _ _   -> [a, " & ", b]+    MUBWOr   _ _   -> [a, " | ", b]+    MUBWXor  _ _   -> [a, " ^ ", b]+    MUBWShiftL _ _ -> [a, " << ", b]+    MUBWShiftR _ _ -> [a, " >> ", b]+    MUEq  _ _      -> [a, " == ", b]+    MULt  _ _      -> [a, " < " , b]+    MUMux _ _ _    -> [a, " ? " , b, " : ", c]+    MUF2B _        -> ["*((", ct Word32, " *) &(", a, "))"]+    MUD2B _        -> ["*((", ct Word64, " *) &(", a, "))"]+    MUB2F _        -> ["*((", ct Float , " *) &(", a, "))"]+    MUB2D _        -> ["*((", ct Double, " *) &(", a, "))"] -- math.h:-    MUPi                  -> [ "M_PI" ]-    MUExp   _             -> [ "exp",   f, " ( ", a, " )"]-    MULog   _             -> [ "log",   f, " ( ", a, " )"]-    MUSqrt  _             -> [ "sqrt",  f, " ( ", a, " )"]-    MUPow   _ _           -> [ "pow",   f, " ( ", a, ", ", b, " )"]-    MUSin   _             -> [ "sin",   f, " ( ", a, " )"]-    MUAsin  _             -> [ "asin",  f, " ( ", a, " )"]-    MUCos   _             -> [ "cos",   f, " ( ", a, " )"]-    MUAcos  _             -> [ "acos",  f, " ( ", a, " )"]-    MUSinh  _             -> [ "sinh",  f, " ( ", a, " )"]-    MUCosh  _             -> [ "cosh",  f, " ( ", a, " )"]-    MUAsinh _             -> [ "asinh", f, " ( ", a, " )"]-    MUAcosh _             -> [ "acosh", f, " ( ", a, " )"]-    MUAtan  _             -> [ "atan",  f, " ( ", a, " )"]-    MUAtanh _             -> [ "atanh", f, " ( ", a, " )"]+    MUPi           -> [ "M_PI" ]+    MUExp   _      -> [ "exp",   f, " ( ", a, " )"]+    MULog   _      -> [ "log",   f, " ( ", a, " )"]+    MUSqrt  _      -> [ "sqrt",  f, " ( ", a, " )"]+    MUPow   _ _    -> [ "pow",   f, " ( ", a, ", ", b, " )"]+    MUSin   _      -> [ "sin",   f, " ( ", a, " )"]+    MUAsin  _      -> [ "asin",  f, " ( ", a, " )"]+    MUCos   _      -> [ "cos",   f, " ( ", a, " )"]+    MUAcos  _      -> [ "acos",  f, " ( ", a, " )"]+    MUSinh  _      -> [ "sinh",  f, " ( ", a, " )"]+    MUCosh  _      -> [ "cosh",  f, " ( ", a, " )"]+    MUAsinh _      -> [ "asinh", f, " ( ", a, " )"]+    MUAcosh _      -> [ "acosh", f, " ( ", a, " )"]+    MUAtan  _      -> [ "atan",  f, " ( ", a, " )"]+    MUAtanh _      -> [ "atanh", f, " ( ", a, " )"]     where       ct = cType       a = head operands@@ -175,7 +184,7 @@ type RuleCoverage = [(Name, Int, Int)]  -- containMathHFunctions :: [Rule] -> Bool--- containMathHFunctions rules = +-- containMathHFunctions rules = --   any math rules --   where math rule = case rule of --                       Rule _ _ _ _ _ _ _ b -> b@@ -188,11 +197,12 @@   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+  (preCode,  postCode)  = cCode config assertionNames coverageNames probeNames+  (preHCode, postHCode) = hCode config assertionNames coverageNames probeNames   c = unlines     [ "#include <stdbool.h>"     , "#include <stdint.h>"-    , codeIf (M.fold (\_ e ans -> isMathHCall e || ans ) False (snd mp)) +    , codeIf (M.fold (\_ e ans -> isMathHCall e || ans ) False (snd mp))              "#include <math.h>"     , ""     , preCode@@ -208,13 +218,13 @@     , codeIf (cRuleCoverage config) $ "static " ++ cType Word32                  ++ " __coverage[" ++ show covLen ++ "] = {"                  ++ (concat $ intersperse ", " $ replicate covLen "0") ++ "};"-    , codeIf (cRuleCoverage config) +    , codeIf (cRuleCoverage config)              ("static " ++ cType Word32 ++ " __coverage_index = 0;")     , declState True (StateHierarchy (cStateName config) [state])     , concatMap (codeRule mp config) rules'     , codeAssertionChecks mp config assertionNames coverageNames rules-    , "void " ++ funcName ++ "() {"-    , swOrHwClock+    , "void " ++ funcName ++ "()"+    , "{"     , unlines [ swOrHwClock               , codePeriodPhases               , "  " ++ globalClk ++ " = " ++ globalClk ++ " + 1;"@@ -352,9 +362,13 @@     [ "#include <stdbool.h>"     , "#include <stdint.h>"     , ""+    , preHCode+    , ""     , "void " ++ funcName ++ "();"     , ""     , declState False (StateHierarchy (cStateName config) [state])+    , ""+    , postHCode     ]    globalType = cType (case hardwareClock config of@@ -383,25 +397,25 @@ codeIf a b = if a then b else ""  declState :: Bool -> StateHierarchy -> String-declState define a = -     (if define then "" else "extern ") ++ init (init (f1 "" a)) +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" +    StateHierarchy name items ->+         i ++ "struct {  /* " ++ name ++ " */\n"       ++ concatMap (f1 ("  " ++ i)) items ++ i ++ "} " ++ name ++ ";\n"     StateVariable  name c     -> i ++ cType (E.typeOf c) ++ " " ++ name ++ ";\n"-    StateArray     name c     -> +    StateArray     name c     ->       i ++ cType (E.typeOf $ head c) ++ " " ++ name ++ "[" ++ show (length c) ++ "];\n"    f2 i a = case a of-    StateHierarchy name items -> -         i ++ "{  /* " ++ name ++ " */\n" +    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 ++ " */\n" ++ i ++ "{ " +    StateArray     name c     ->+         i ++ "/* " ++ name ++ " */\n" ++ i ++ "{ "       ++ intercalate ("\n" ++ i ++ ", ") (map showConst c) ++ "\n" ++ i ++ "}"  codeRule :: UeMap -> Config -> Rule -> String@@ -411,9 +425,9 @@   concatMap (codeUE mp config ues "  ") ues ++   "  if (" ++ id (ruleEnable rule) ++ ") {\n" ++   concatMap codeAction (ruleActions rule) ++-  codeIf (cRuleCoverage config) -         ( "    __coverage[" ++ covWord ++ "] = __coverage[" ++ covWord -          ++ "] | (1 << " ++ covBit ++ ");\n") +  codeIf (cRuleCoverage config)+         ( "    __coverage[" ++ covWord ++ "] = __coverage[" ++ covWord+          ++ "] | (1 << " ++ covBit ++ ");\n")   ++ "  }\n" ++ concatMap codeAssign (ruleAssigns rule) ++ "}\n\n"   where   ues = topo mp $ allUEs rule@@ -430,7 +444,7 @@     where     lh = case uv of       MUV _ n _                     -> concat [cStateName config, ".", n]-      MUVArray (UA _ n _)     index -> +      MUVArray (UA _ n _)     index ->         concat [cStateName config, ".", n, "[", id index, "]"]       MUVArray (UAExtern n _) index -> concat [n, "[", id index, "]"]       MUVExtern n _                 -> n@@ -441,21 +455,21 @@ globalClk = "__global_clock"  codeAssertionChecks :: UeMap -> Config -> [Name] -> [Name] -> [Rule] -> String-codeAssertionChecks mp config assertionNames coverageNames rules = +codeAssertionChecks mp config assertionNames coverageNames rules =   codeIf (cAssert config) $   "static void __assertion_checks() {\n" ++   concatMap (codeUE mp config ues "  ") ues ++-  concat [     "  if (" ++ id enable ++ ") " ++ cAssertName config -            ++ "(" ++ assertionId name ++ ", " ++ id check ++ ", " -            ++ globalClk ++ ");\n"                                 +  concat [     "  if (" ++ id enable ++ ") " ++ cAssertName config+            ++ "(" ++ assertionId name ++ ", " ++ id check ++ ", "+            ++ globalClk ++ ");\n"           | Assert name enable check <- rules ] ++-  concat [     "  if (" ++ id enable ++ ") " ++ cCoverName  config -            ++ "(" ++ coverageId  name ++ ", " ++ id check ++ ", " -            ++ globalClk ++ ");\n"                                 +  concat [     "  if (" ++ id enable ++ ") " ++ cCoverName  config+            ++ "(" ++ coverageId  name ++ ", " ++ id check ++ ", "+            ++ globalClk ++ ");\n"           | Cover  name enable check <- rules ] ++   "}\n\n"   where-  ues = topo mp $    concat [ [a, b] | Assert _ a b <- rules ] +  ues = topo mp $    concat [ [a, b] | Assert _ a b <- rules ]                   ++ concat [ [a, b] | Cover _ a b <- rules ]   id ue = fromJust $ lookup ue ues   assertionId :: Name -> String

@@ -367,12 +367,11 @@       put (st, (g, atom { atomNames = name : atomNames atom }))       return $ atomName atom ++ "." ++ name --- still accepts some misformed names+-- still accepts some misformed names, like "_.." or "_][" checkName :: Name -> Atom () checkName name =-  if (\ x -> isAlpha x || x == '_') (head name) && -      and (map (\ x -> isAlphaNum x || x `elem` "._-[]") (tail name)) && -      and (map isAscii name)+  if (\ x -> isAlpha x || x == '_') (head name) &&+      and (map (\ x -> isAlphaNum x || x `elem` "._[]") (tail name))     then return ()     else error $ "ERROR: Name \"" ++ name ++ "\" is not a valid identifier." 

@@ -42,6 +42,17 @@   , any_   , all_   , imply+  -- * Bit-wise Operations+  , (.&.)+  , complement+  , (.|.)+  , xor+  , (.<<.)+  , (.>>.)+  , rol+  , ror+  , bitSize+  , isSigned   -- * Equality and Comparison   , (==.)   , (/=.)@@ -183,44 +194,46 @@  -- | A typed expression. data E a where-  VRef    :: V a -> E a-  Const   :: a -> 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-  Mul     :: NumE a => E a -> E a -> E a-  Div     :: NumE a => E a -> E a -> E a-  Mod     :: IntegralE a => E a -> E a -> E a-  Not     :: E Bool -> E Bool-  And     :: E Bool -> E Bool -> E Bool-  BWNot   :: IntegralE a => E a -> E a-  BWAnd   :: IntegralE a => E a -> E a -> E a-  BWOr    :: IntegralE a => E a -> E a -> E a-  Shift   :: IntegralE a => E a -> Int -> E a-  Eq      :: EqE a  => E a -> E a -> E Bool-  Lt      :: OrdE a => E a -> E a -> E Bool-  Mux     :: E Bool -> E a -> E a -> E a-  F2B     :: E Float  -> E Word32-  D2B     :: E Double -> E Word64-  B2F     :: E Word32 -> E Float-  B2D     :: E Word64 -> E Double-  Retype  :: UE -> E a+  VRef     :: V a -> E a+  Const    :: a -> 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+  Mul      :: NumE a => E a -> E a -> E a+  Div      :: NumE a => E a -> E a -> E a+  Mod      :: IntegralE a => E a -> E a -> E a+  Not      :: E Bool -> E Bool+  And      :: E Bool -> E Bool -> E Bool+  BWNot    :: IntegralE a => E a -> E a+  BWAnd    :: IntegralE a => E a -> E a -> E a+  BWOr     :: IntegralE a => E a -> E a -> E a+  BWXor    :: IntegralE a => E a -> E a -> E a+  BWShiftL :: ( IntegralE a, IntegralE b ) => E a -> E b -> E a+  BWShiftR :: ( IntegralE a, IntegralE b ) => E a -> E b -> E a+  Eq       :: EqE a  => E a -> E a -> E Bool+  Lt       :: OrdE a => E a -> E a -> E Bool+  Mux      :: E Bool -> E a -> E a -> E a+  F2B      :: E Float  -> E Word32+  D2B      :: E Double -> E Word64+  B2F      :: E Word32 -> E Float+  B2D      :: E Word64 -> E Double+  Retype   :: UE -> E a -- math.h:-  Pi      :: FloatingE a => E a-  Exp     :: FloatingE a => E a -> E a-  Log     :: FloatingE a => E a -> E a-  Sqrt    :: FloatingE a => E a -> E a-  Pow     :: FloatingE a => E a -> E a -> E a-  Sin     :: FloatingE a => E a -> E a-  Asin    :: FloatingE a => E a -> E a-  Cos     :: FloatingE a => E a -> E a-  Acos    :: FloatingE a => E a -> E a-  Sinh    :: FloatingE a => E a -> E a-  Cosh    :: FloatingE a => E a -> E a-  Asinh   :: FloatingE a => E a -> E a-  Acosh   :: FloatingE a => E a -> E a-  Atan    :: FloatingE a => E a -> E a-  Atanh   :: FloatingE a => E a -> E a+  Pi       :: FloatingE a => E a+  Exp      :: FloatingE a => E a -> E a+  Log      :: FloatingE a => E a -> E a+  Sqrt     :: FloatingE a => E a -> E a+  Pow      :: FloatingE a => E a -> E a -> E a+  Sin      :: FloatingE a => E a -> E a+  Asin     :: FloatingE a => E a -> E a+  Cos      :: FloatingE a => E a -> E a+  Acos     :: FloatingE a => E a -> E a+  Sinh     :: FloatingE a => E a -> E a+  Cosh     :: FloatingE a => E a -> E a+  Asinh    :: FloatingE a => E a -> E a+  Acosh    :: FloatingE a => E a -> E a+  Atan     :: FloatingE a => E a -> E a+  Atanh    :: FloatingE a => E a -> E a  instance Show (E a) where   show _ = error "Show (E a) not implemented"@@ -230,43 +243,45 @@  -- | An untyped term. data UE-  = UVRef UV-  | UConst Const-  | UCast  Type UE-  | UAdd   UE UE-  | USub   UE UE-  | UMul   UE UE-  | UDiv   UE UE-  | UMod   UE UE-  | UNot   UE-  | UAnd   [UE]-  | UBWNot UE-  | UBWAnd UE UE-  | UBWOr  UE UE-  | UShift UE Int-  | UEq    UE UE-  | ULt    UE UE-  | UMux   UE UE UE-  | UF2B   UE-  | UD2B   UE-  | UB2F   UE-  | UB2D   UE+  = UVRef     UV+  | UConst    Const+  | UCast     Type UE+  | UAdd      UE UE+  | USub      UE UE+  | UMul      UE UE+  | UDiv      UE UE+  | UMod      UE UE+  | UNot      UE+  | UAnd      [UE]+  | UBWNot    UE+  | UBWAnd    UE UE+  | UBWOr     UE UE+  | UBWXor    UE UE+  | UBWShiftL UE UE+  | UBWShiftR UE UE+  | UEq       UE UE+  | ULt       UE UE+  | UMux      UE UE UE+  | UF2B      UE+  | UD2B      UE+  | UB2F      UE+  | UB2D      UE -- math.h:   | UPi-  | UExp   UE-  | ULog   UE-  | USqrt  UE-  | UPow   UE UE-  | USin   UE-  | UAsin  UE-  | UCos   UE-  | UAcos  UE-  | USinh  UE-  | UCosh  UE-  | UAsinh UE-  | UAcosh UE-  | UAtan  UE-  | UAtanh UE+  | UExp      UE+  | ULog      UE+  | USqrt     UE+  | UPow      UE UE+  | USin      UE+  | UAsin     UE+  | UCos      UE+  | UAcos     UE+  | USinh     UE+  | UCosh     UE+  | UAsinh    UE+  | UAcosh    UE+  | UAtan     UE+  | UAtanh    UE   deriving (Show, Eq, Ord, Data, Typeable)  class Width a where@@ -330,43 +345,45 @@  instance TypeOf UE where   typeOf t = case t of-    UVRef uvar -> typeOf uvar-    UCast t _  -> t-    UConst c   -> typeOf c-    UAdd a _   -> typeOf a-    USub a _   -> typeOf a-    UMul a _   -> typeOf a-    UDiv a _   -> typeOf a-    UMod a _   -> typeOf a-    UNot _     -> Bool-    UAnd _     -> Bool-    UBWNot a   -> typeOf a-    UBWAnd a _ -> typeOf a-    UBWOr  a _ -> typeOf a-    UShift a _ -> typeOf a-    UEq  _ _   -> Bool-    ULt  _ _   -> Bool-    UMux _ a _ -> typeOf a-    UF2B _     -> Word32-    UD2B _     -> Word64-    UB2F _     -> Float-    UB2D _     -> Double+    UVRef     uvar  -> typeOf uvar+    UCast     t _   -> t+    UConst    c     -> typeOf c+    UAdd      a _   -> typeOf a+    USub      a _   -> typeOf a+    UMul      a _   -> typeOf a+    UDiv      a _   -> typeOf a+    UMod      a _   -> typeOf a+    UNot      _     -> Bool+    UAnd      _     -> Bool+    UBWNot    a     -> typeOf a+    UBWAnd    a _   -> typeOf a+    UBWOr     a _   -> typeOf a+    UBWXor    a _   -> typeOf a+    UBWShiftL a _   -> typeOf a+    UBWShiftR a _   -> typeOf a+    UEq       _ _   -> Bool+    ULt       _ _   -> Bool+    UMux      _ a _ -> typeOf a+    UF2B      _     -> Word32+    UD2B      _     -> Word64+    UB2F      _     -> Float+    UB2D      _     -> Double -- math.h:-    UPi        -> Double-    UExp   a   -> typeOf a-    ULog   a   -> typeOf a-    USqrt  a   -> typeOf a-    UPow   a _ -> typeOf a-    USin   a   -> typeOf a-    UAsin  a   -> typeOf a-    UCos   a   -> typeOf a-    UAcos  a   -> typeOf a-    USinh  a   -> typeOf a-    UCosh  a   -> typeOf a-    UAsinh a   -> typeOf a-    UAcosh a   -> typeOf a-    UAtan  a   -> typeOf a-    UAtanh a   -> typeOf a+    UPi           -> Double+    UExp      a     -> typeOf a+    ULog      a     -> typeOf a+    USqrt     a     -> typeOf a+    UPow      a _   -> typeOf a+    USin      a     -> typeOf a+    UAsin     a     -> typeOf a+    UCos      a     -> typeOf a+    UAcos     a     -> typeOf a+    USinh     a     -> typeOf a+    UCosh     a     -> typeOf a+    UAsinh    a     -> typeOf a+    UAcosh    a     -> typeOf a+    UAtan     a     -> typeOf a+    UAtanh    a     -> typeOf a  instance Expr a => TypeOf (E a) where   typeOf = eType@@ -553,25 +570,39 @@  instance (Expr a, OrdE a, EqE a, IntegralE a, Bits a) => Bits (E a) where   (Const a) .&. (Const b) = Const $ a .&. b-  a .&. b = BWAnd a b-  complement (Const a) = Const $ complement a-  complement a = BWNot a+  a .&. b                 = BWAnd a b+  complement (Const a)    = Const $ complement a+  complement a            = BWNot a   (Const a) .|. (Const b) = Const $ a .|. b-  a .|. b = BWOr a b-  xor a b = (a .&. complement b) .|. (complement a .&. b)-  shift (Const a) n = Const $ shift a n-  shift a n = Shift a n-  rotate a n | n >= width a = error "E rotates too far."-  rotate (Const a) n = Const $ rotate a n-  rotate a n | n > 0     = shift a n .|. shift a (width a - n) .&. Const (mask n)-             | n < 0     = shift a n .&. Const (mask $ width a + n) .|. shift a (width a + n)-             | otherwise = a-    where-    mask 0 = 0-    mask n = shiftL (mask $ n - 1) 1 + 1+  a .|. b                 = BWOr  a b+  xor                     = BWXor++  shiftL a b              = error "shiftL undefined, for left-shifting use .<<."+  shiftR a b              = error "shiftR undefined, for right-shifting use .>>."++  rotateL a n             = error "rotateL undefined, for left-rotation use rol"+  rotateR a n             = error "rotateR undefined, for right-rotation use ror"   bitSize = width   isSigned = signed +-- | Bitwise left-shifting.+(.<<.) :: ( Bits a, IntegralE a, IntegralE n ) => E a -> E n -> E a+( Const a ) .<<. ( Const n ) = Const $ shiftL a $ fromIntegral n+a .<<. n                     = BWShiftL a n++-- | Bitwise right-shifting.+(.>>.) :: ( Bits a, IntegralE a, IntegralE n ) => E a -> E n -> E a+( Const a ) .>>. ( Const n ) =  Const $ shiftR a $ fromIntegral n+a .>>. n = BWShiftR a n++-- | Bitwise left-rotation.+rol (Const a) (Const n) = Const $ rotateL a $ fromIntegral n+rol a n = a .<<. n .|. a .>>. ( ( Const . fromIntegral . width ) a - n )++-- | Bitwise right-rotation.+ror (Const a) (Const n) = Const $ rotateR a $ fromIntegral n+ror a n = a .>>. n .|. a .<<. ( ( Const . fromIntegral . width ) a - n )+ -- | True term. true :: E Bool true = Const True@@ -609,7 +640,7 @@ any_ f a = or_ $ map f a  -- Logical implication (if a then b).-imply :: E Bool -> E Bool -> E Bool +imply :: E Bool -> E Bool -> E Bool imply a b = not_ a ||. b  -- | Equal.@@ -713,44 +744,46 @@ -- | Converts an typed expression (E a) to an untyped expression (UE). ue :: Expr a => E a -> UE ue t = case t of-  VRef (V v)   -> UVRef v-  Const  a     -> UConst $ constant a-  Cast   a     -> UCast    tt (ue a)-  Add    a b   -> UAdd     (ue a) (ue b)-  Sub    a b   -> USub     (ue a) (ue b)-  Mul    a b   -> UMul     (ue a) (ue b)-  Div    a b   -> UDiv     (ue a) (ue b)-  Mod    a b   -> UMod     (ue a) (ue b)-  Not    a     -> unot     (ue a)-  And    a b   -> uand     (ue a) (ue b)-  BWNot  a     -> UBWNot   (ue a)-  BWAnd  a b   -> UBWAnd   (ue a) (ue b)-  BWOr   a b   -> UBWOr    (ue a) (ue b)-  Shift  a b   -> UShift   (ue a) b-  Eq     a b   -> ueq      (ue a) (ue b)-  Lt     a b   -> ult      (ue a) (ue b)-  Mux    a b c -> umux     (ue a) (ue b) (ue c)-  F2B    a     -> UF2B     (ue a)-  D2B    a     -> UD2B     (ue a)-  B2F    a     -> UB2F     (ue a)-  B2D    a     -> UB2D     (ue a)-  Retype a     -> a+  VRef     (V v)   -> UVRef v+  Const    a     -> UConst  $ constant a+  Cast     a     -> UCast     tt (ue a)+  Add      a b   -> UAdd      (ue a) (ue b)+  Sub      a b   -> USub      (ue a) (ue b)+  Mul      a b   -> UMul      (ue a) (ue b)+  Div      a b   -> UDiv      (ue a) (ue b)+  Mod      a b   -> UMod      (ue a) (ue b)+  Not      a     -> unot      (ue a)+  And      a b   -> uand      (ue a) (ue b)+  BWNot    a     -> UBWNot    (ue a)+  BWAnd    a b   -> UBWAnd    (ue a) (ue b)+  BWOr     a b   -> UBWOr     (ue a) (ue b)+  BWXor    a b   -> UBWXor    (ue a) (ue b)+  BWShiftL a b   -> UBWShiftL (ue a) (ue b)+  BWShiftR a b   -> UBWShiftR (ue a) (ue b)+  Eq       a b   -> ueq       (ue a) (ue b)+  Lt       a b   -> ult       (ue a) (ue b)+  Mux      a b c -> umux      (ue a) (ue b) (ue c)+  F2B      a     -> UF2B      (ue a)+  D2B      a     -> UD2B      (ue a)+  B2F      a     -> UB2F      (ue a)+  B2D      a     -> UB2D      (ue a)+  Retype   a     -> a -- math.h:   Pi           -> UPi-  Exp    a     -> UExp   (ue a)-  Log    a     -> ULog   (ue a)-  Sqrt   a     -> USqrt  (ue a)-  Pow    a b   -> UPow   (ue a) (ue b)-  Sin    a     -> USin   (ue a)-  Asin   a     -> UAsin  (ue a)-  Cos    a     -> UCos   (ue a)-  Acos   a     -> UAcos  (ue a)-  Sinh   a     -> USinh  (ue a)-  Cosh   a     -> UCosh  (ue a)-  Asinh  a     -> UAsinh (ue a)-  Acosh  a     -> UAcosh (ue a)-  Atan   a     -> UAtan  (ue a)-  Atanh  a     -> UAtanh (ue a)+  Exp      a     -> UExp      (ue a)+  Log      a     -> ULog      (ue a)+  Sqrt     a     -> USqrt     (ue a)+  Pow      a b   -> UPow      (ue a) (ue b)+  Sin      a     -> USin      (ue a)+  Asin     a     -> UAsin     (ue a)+  Cos      a     -> UCos      (ue a)+  Acos     a     -> UAcos     (ue a)+  Sinh     a     -> USinh     (ue a)+  Cosh     a     -> UCosh     (ue a)+  Asinh    a     -> UAsinh    (ue a)+  Acosh    a     -> UAcosh    (ue a)+  Atan     a     -> UAtan     (ue a)+  Atanh    a     -> UAtanh    (ue a)    where   tt = eType t@@ -867,7 +900,7 @@   UBWNot a     -> UBWNot (balance a)   UBWAnd a b   -> UBWAnd (balance a) (balance b)   UBWOr  a b   -> UBWOr  (balance a) (balance b)-  UShift a n   -> UShift (balance a) n+  UShift a b   -> UShift (balance a) (balance b)   UEq  a b     -> UEq    (balance a) (balance b)   ULt  a b     -> ULt    (balance a) (balance b)   UMux a t f   -> rotate $ umux a t' f'

@@ -1,6 +1,6 @@ -- | Sharing for UEs, based on IntMaps.  The idea is to share subexpressions of 'UE's. -module Language.Atom.UeMap +module Language.Atom.UeMap   ( UeElem (..)   , MUV (..)   , UeMap@@ -39,7 +39,7 @@  -- | Transforms a 'UV' into a 'MUV', returning the possibly updated map. newUV :: UV -> UeMap -> (MUV, UeMap)-newUV uv mp = +newUV uv mp =   case uv of     UV i j k       -> (MUV i j k, mp)     UVExtern i j   -> (MUVExtern i j, mp)@@ -48,87 +48,91 @@  -- | Corresponds to 'UE's --- the elements in the sharing structure. data UeElem-  = MUVRef !MUV-  | MUConst !Const-  | MUCast  !Type !Hash-  | MUAdd   !Hash !Hash-  | MUSub   !Hash !Hash-  | MUMul   !Hash !Hash-  | MUDiv   !Hash !Hash-  | MUMod   !Hash !Hash-  | MUNot   !Hash-  | MUAnd   [Hash]-  | MUBWNot !Hash-  | MUBWAnd !Hash !Hash-  | MUBWOr  !Hash !Hash-  | MUShift !Hash !Int-  | MUEq    !Hash !Hash-  | MULt    !Hash !Hash-  | MUMux   !Hash !Hash !Hash-  | MUF2B   !Hash-  | MUD2B   !Hash-  | MUB2F   !Hash-  | MUB2D   !Hash+  = MUVRef     !MUV+  | MUConst    !Const+  | MUCast     !Type !Hash+  | MUAdd      !Hash !Hash+  | MUSub      !Hash !Hash+  | MUMul      !Hash !Hash+  | MUDiv      !Hash !Hash+  | MUMod      !Hash !Hash+  | MUNot      !Hash+  | MUAnd      [Hash]+  | MUBWNot    !Hash+  | MUBWAnd    !Hash !Hash+  | MUBWOr     !Hash !Hash+  | MUBWXor    !Hash !Hash+  | MUBWShiftL !Hash !Hash+  | MUBWShiftR !Hash !Hash+  | MUEq       !Hash !Hash+  | MULt       !Hash !Hash+  | MUMux      !Hash !Hash !Hash+  | MUF2B      !Hash+  | MUD2B      !Hash+  | MUB2F      !Hash+  | MUB2D      !Hash -- math.h:   | MUPi-  | MUExp   !Hash-  | MULog   !Hash-  | MUSqrt  !Hash-  | MUPow   !Hash !Hash-  | MUSin   !Hash-  | MUAsin  !Hash-  | MUCos   !Hash-  | MUAcos  !Hash-  | MUSinh  !Hash-  | MUCosh  !Hash-  | MUAsinh !Hash-  | MUAcosh !Hash-  | MUAtan  !Hash-  | MUAtanh !Hash+  | MUExp      !Hash+  | MULog      !Hash+  | MUSqrt     !Hash+  | MUPow      !Hash !Hash+  | MUSin      !Hash+  | MUAsin     !Hash+  | MUCos      !Hash+  | MUAcos     !Hash+  | MUSinh     !Hash+  | MUCosh     !Hash+  | MUAsinh    !Hash+  | MUAcosh    !Hash+  | MUAtan     !Hash+  | MUAtanh    !Hash   deriving (Show, Eq, Ord)  typeOf :: Hash -> UeMap -> Type typeOf h mp = case getUE h mp of-    MUVRef (MUV _ _ a) -> E.typeOf a-    MUVRef (MUVArray a _) -> E.typeOf a-    MUVRef (MUVExtern _ t) -> t-    MUCast t _  -> t-    MUConst c   -> E.typeOf c-    MUAdd a _   -> typeOf' a-    MUSub a _   -> typeOf' a-    MUMul a _   -> typeOf' a-    MUDiv a _   -> typeOf' a-    MUMod a _   -> typeOf' a-    MUNot _     -> Bool-    MUAnd _     -> Bool-    MUBWNot a   -> typeOf' a-    MUBWAnd a _ -> typeOf' a-    MUBWOr  a _ -> typeOf' a-    MUShift a _ -> typeOf' a-    MUEq  _ _   -> Bool-    MULt  _ _   -> Bool-    MUMux _ a _ -> typeOf' a-    MUF2B _     -> Word32-    MUD2B _     -> Word64-    MUB2F _     -> Float-    MUB2D _     -> Double+    MUVRef     (MUV _ _ a)     -> E.typeOf a+    MUVRef     (MUVArray a _)  -> E.typeOf a+    MUVRef     (MUVExtern _ t) -> t+    MUCast     t _             -> t+    MUConst    c               -> E.typeOf c+    MUAdd      a _             -> typeOf' a+    MUSub      a _             -> typeOf' a+    MUMul      a _             -> typeOf' a+    MUDiv      a _             -> typeOf' a+    MUMod      a _             -> typeOf' a+    MUNot      _               -> Bool+    MUAnd      _               -> Bool+    MUBWNot    a               -> typeOf' a+    MUBWAnd    a _             -> typeOf' a+    MUBWOr     a _             -> typeOf' a+    MUBWXor    a _             -> typeOf' a+    MUBWShiftL a _             -> typeOf' a+    MUBWShiftR a _             -> typeOf' a+    MUEq       _ _             -> Bool+    MULt       _ _             -> Bool+    MUMux      _ a _           -> typeOf' a+    MUF2B      _               -> Word32+    MUD2B      _               -> Word64+    MUB2F      _               -> Float+    MUB2D      _               -> Double -- math.h:-    MUPi        -> Double-    MUExp   a   -> typeOf' a-    MULog   a   -> typeOf' a-    MUSqrt  a   -> typeOf' a-    MUPow   a _ -> typeOf' a-    MUSin   a   -> typeOf' a-    MUAsin  a   -> typeOf' a-    MUCos   a   -> typeOf' a-    MUAcos  a   -> typeOf' a-    MUSinh  a   -> typeOf' a-    MUCosh  a   -> typeOf' a-    MUAsinh a   -> typeOf' a-    MUAcosh a   -> typeOf' a-    MUAtan  a   -> typeOf' a-    MUAtanh a   -> typeOf' a-  where +    MUPi                       -> Double+    MUExp     a                -> typeOf' a+    MULog     a                -> typeOf' a+    MUSqrt    a                -> typeOf' a+    MUPow     a _              -> typeOf' a+    MUSin     a                -> typeOf' a+    MUAsin    a                -> typeOf' a+    MUCos     a                -> typeOf' a+    MUAcos    a                -> typeOf' a+    MUSinh    a                -> typeOf' a+    MUCosh    a                -> typeOf' a+    MUAsinh   a                -> typeOf' a+    MUAcosh   a                -> typeOf' a+    MUAtan    a                -> typeOf' a+    MUAtanh   a                -> typeOf' a+  where   typeOf' h' = typeOf h' mp  -- | An entry in the Map.@@ -140,7 +144,7 @@ -- | Get the element associated with a 'Hash' value.  It's an error if the -- element is not in the map. getUE :: Hash -> UeMap -> UeElem-getUE h (_,mp) = +getUE h (_,mp) =   case M.lookup h mp of     Nothing -> error $ "Error looking up hash " ++ show h ++ " in the UE map\n" ++ show mp     Just e -> e@@ -155,70 +159,72 @@  -- | Create the sharing map. share :: UE -> UeState Hash-share e = case e of -  UVRef (UV i j k) -> maybeUpdate (MUVRef $ MUV i j k)-  UVRef (UVExtern i j) -> maybeUpdate (MUVRef $ MUVExtern i j)-  UVRef (UVArray arr a) -> unOp a (\x -> MUVRef (MUVArray arr x))-  UConst  a     -> maybeUpdate (MUConst a)-  UCast   t a   -> unOp a (MUCast t)-  UAdd    a b   -> binOp (a,b) MUAdd-  USub    a b   -> binOp (a,b) MUSub-  UMul    a b   -> binOp (a,b) MUMul-  UDiv    a b   -> binOp (a,b) MUDiv-  UMod    a b   -> binOp (a,b) MUMod-  UNot    a     -> unOp a MUNot-  UAnd    ls    -> listOp ls MUAnd-  UBWNot  a     -> unOp a MUBWNot-  UBWAnd  a b   -> binOp (a,b) MUBWAnd-  UBWOr   a b   -> binOp (a,b) MUBWOr-  UShift  a b   -> unOp a (\x -> MUShift x b)-  UEq     a b   -> binOp (a,b) MUEq-  ULt     a b   -> binOp (a,b) MULt-  UMux    a b c -> triOp (a,b,c) MUMux-  UF2B    a     -> unOp a MUF2B-  UD2B    a     -> unOp a MUD2B-  UB2F    a     -> unOp a MUB2F-  UB2D    a     -> unOp a MUB2D+share e = case e of+  UVRef     (UV i j k)      -> maybeUpdate (MUVRef $ MUV i j k)+  UVRef     (UVExtern i j)  -> maybeUpdate (MUVRef $ MUVExtern i j)+  UVRef     (UVArray arr a) -> unOp a (\x -> MUVRef (MUVArray arr x))+  UConst    a     -> maybeUpdate (MUConst a)+  UCast     t a   -> unOp a (MUCast t)+  UAdd      a b   -> binOp (a,b) MUAdd+  USub      a b   -> binOp (a,b) MUSub+  UMul      a b   -> binOp (a,b) MUMul+  UDiv      a b   -> binOp (a,b) MUDiv+  UMod      a b   -> binOp (a,b) MUMod+  UNot      a     -> unOp a MUNot+  UAnd      ls    -> listOp ls MUAnd+  UBWNot    a     -> unOp a MUBWNot+  UBWAnd    a b   -> binOp (a,b) MUBWAnd+  UBWOr     a b   -> binOp (a,b) MUBWOr+  UBWXor    a b   -> binOp (a,b) MUBWXor+  UBWShiftL a b   -> binOp (a,b) MUBWShiftL+  UBWShiftR a b   -> binOp (a,b) MUBWShiftR+  UEq       a b   -> binOp (a,b) MUEq+  ULt       a b   -> binOp (a,b) MULt+  UMux      a b c -> triOp (a,b,c) MUMux+  UF2B      a     -> unOp a MUF2B+  UD2B      a     -> unOp a MUD2B+  UB2F      a     -> unOp a MUB2F+  UB2D      a     -> unOp a MUB2D -- math.h:-  UPi           -> maybeUpdate (MUPi)-  UExp    a     -> unOp a MUExp-  ULog    a     -> unOp a MULog-  USqrt   a     -> unOp a MUSqrt-  UPow    a b   -> binOp (a,b) MUPow-  USin    a     -> unOp a MUSin-  UAsin   a     -> unOp a MUAsin-  UCos    a     -> unOp a MUCos-  UAcos   a     -> unOp a MUAcos-  USinh   a     -> unOp a MUSinh-  UCosh   a     -> unOp a MUCosh-  UAsinh  a     -> unOp a MUAsinh-  UAcosh  a     -> unOp a MUAcosh-  UAtan   a     -> unOp a MUAtan-  UAtanh  a     -> unOp a MUAtanh+  UPi             -> maybeUpdate (MUPi)+  UExp      a     -> unOp a MUExp+  ULog      a     -> unOp a MULog+  USqrt     a     -> unOp a MUSqrt+  UPow      a b   -> binOp (a,b) MUPow+  USin      a     -> unOp a MUSin+  UAsin     a     -> unOp a MUAsin+  UCos      a     -> unOp a MUCos+  UAcos     a     -> unOp a MUAcos+  USinh     a     -> unOp a MUSinh+  UCosh     a     -> unOp a MUCosh+  UAsinh    a     -> unOp a MUAsinh+  UAcosh    a     -> unOp a MUAcosh+  UAtan     a     -> unOp a MUAtan+  UAtanh    a     -> unOp a MUAtanh  -- XXX I could combine some of the following functions (unOp, binOp, etc.) to -- slightly reduce code... unOp :: UE -> (Hash -> UeElem) -> UeState Hash unOp e code = do-  h <- share e  +  h <- share e   maybeUpdate (code h)  binOp :: (UE, UE) -> (Hash -> Hash -> UeElem) -> UeState Hash binOp (e0,e1) code = do-  h0 <- share e0  -  h1 <- share e1  +  h0 <- share e0+  h1 <- share e1   maybeUpdate (code h0 h1)  triOp :: (UE, UE, UE) -> (Hash -> Hash -> Hash -> UeElem) -> UeState Hash triOp (e0,e1,e2) code = do-  h0 <- share e0   -  h1 <- share e1  -  h2 <- share e2  +  h0 <- share e0+  h1 <- share e1+  h2 <- share e2   maybeUpdate (code h0 h1 h2)  listOp :: [UE] -> ([Hash] -> UeElem) -> UeState Hash listOp es code = do-  hashes <- foldM (\hashes e -> do h <- share e +  hashes <- foldM (\hashes e -> do h <- share e                                    return (h:hashes)                   ) [] es   maybeUpdate (code hashes)@@ -249,89 +255,93 @@ -- | Get a 'UE' back out of the 'UeMap'. recoverUE :: UeMap -> Hash -> UE recoverUE st h = case getUE h st of-  MUVRef (MUV i j k)     -> UVRef (UV i j k)-  MUVRef (MUVArray i a)  -> UVRef (UVArray i (recover' a))-  MUVRef (MUVExtern i j) -> UVRef (UVExtern i j)-  MUCast t a   -> UCast   t (recover' a)-  MUConst a    -> UConst  a-  MUAdd a b    -> UAdd    (recover' a) (recover' b)-  MUSub a b    -> USub    (recover' a) (recover' b)-  MUMul a b    -> UMul    (recover' a) (recover' b)-  MUDiv a b    -> UDiv    (recover' a) (recover' b)-  MUMod a b    -> UMod    (recover' a) (recover' b)-  MUNot a      -> UNot (recover' a)-  MUAnd a      -> UAnd $ map recover' a-  MUBWNot a    -> UBWNot (recover' a)-  MUBWAnd a b  -> UBWAnd  (recover' a) (recover' b)-  MUBWOr  a b  -> UBWOr   (recover' a) (recover' b)-  MUShift a b  -> UShift  (recover' a) b-  MUEq  a b    -> UEq     (recover' a) (recover' b)-  MULt  a b    -> ULt     (recover' a) (recover' b)-  MUMux a b c  -> UMux (recover' a) (recover' b) (recover' c)-  MUF2B a      -> UF2B    (recover' a)-  MUD2B a      -> UD2B    (recover' a)-  MUB2F a      -> UB2F    (recover' a)-  MUB2D a      -> UB2D    (recover' a)+  MUVRef     (MUV i j k)     -> UVRef (UV i j k)+  MUVRef     (MUVArray i a)  -> UVRef (UVArray i (recover' a))+  MUVRef     (MUVExtern i j) -> UVRef (UVExtern i j)+  MUCast     t a   -> UCast     t (recover' a)+  MUConst    a     -> UConst    a+  MUAdd      a b   -> UAdd      (recover' a) (recover' b)+  MUSub      a b   -> USub      (recover' a) (recover' b)+  MUMul      a b   -> UMul      (recover' a) (recover' b)+  MUDiv      a b   -> UDiv      (recover' a) (recover' b)+  MUMod      a b   -> UMod      (recover' a) (recover' b)+  MUNot      a     -> UNot      (recover' a)+  MUAnd      a     -> UAnd $ map recover' a+  MUBWNot    a     -> UBWNot    (recover' a)+  MUBWAnd    a b   -> UBWAnd    (recover' a) (recover' b)+  MUBWOr     a b   -> UBWOr     (recover' a) (recover' b)+  MUBWXor    a b   -> UBWXor    (recover' a) (recover' b)+  MUBWShiftL a b   -> UBWShiftL (recover' a) (recover' b)+  MUBWShiftR a b   -> UBWShiftR (recover' a) (recover' b)+  MUEq       a b   -> UEq       (recover' a) (recover' b)+  MULt       a b   -> ULt       (recover' a) (recover' b)+  MUMux      a b c -> UMux      (recover' a) (recover' b) (recover' c)+  MUF2B      a     -> UF2B      (recover' a)+  MUD2B      a     -> UD2B      (recover' a)+  MUB2F      a     -> UB2F      (recover' a)+  MUB2D      a     -> UB2D      (recover' a) -- math.h:-  MUPi         -> UPi-  MUExp   a    -> UExp    (recover' a)-  MULog   a    -> ULog    (recover' a)-  MUSqrt  a    -> USqrt   (recover' a)-  MUPow   a b  -> UPow (recover' a) (recover' b)-  MUSin   a    -> USin    (recover' a)-  MUAsin  a    -> UAsin   (recover' a)-  MUCos   a    -> UCos    (recover' a)-  MUAcos  a    -> UAcos   (recover' a)-  MUSinh  a    -> USinh   (recover' a)-  MUCosh  a    -> UCosh   (recover' a)-  MUAsinh a    -> UAsinh  (recover' a)-  MUAcosh a    -> UAcosh  (recover' a)-  MUAtan  a    -> UAtan   (recover' a)-  MUAtanh a    -> UAtanh  (recover' a)+  MUPi             -> UPi+  MUExp      a     -> UExp      (recover' a)+  MULog      a     -> ULog      (recover' a)+  MUSqrt     a     -> USqrt     (recover' a)+  MUPow      a b   -> UPow      (recover' a) (recover' b)+  MUSin      a     -> USin      (recover' a)+  MUAsin     a     -> UAsin     (recover' a)+  MUCos      a     -> UCos      (recover' a)+  MUAcos     a     -> UAcos     (recover' a)+  MUSinh     a     -> USinh     (recover' a)+  MUCosh     a     -> UCosh     (recover' a)+  MUAsinh    a     -> UAsinh    (recover' a)+  MUAcosh    a     -> UAcosh    (recover' a)+  MUAtan     a     -> UAtan     (recover' a)+  MUAtanh    a     -> UAtanh    (recover' a)   where recover' h' = recoverUE st h'  -- | The list of Hashes to adjacent upstream of a UE. ueUpstream :: Hash -> UeMap -> [Hash] ueUpstream h t = case getUE h t of-  MUVRef (MUV _ _ _)     -> []-  MUVRef (MUVArray _ a)  -> [a]-  MUVRef (MUVExtern _ _) -> []-  MUCast _ a   -> [a]-  MUConst _    -> []-  MUAdd a b    -> [a, b]-  MUSub a b    -> [a, b]-  MUMul a b    -> [a, b]-  MUDiv a b    -> [a, b]-  MUMod a b    -> [a, b]-  MUNot a      -> [a]-  MUAnd a      -> a-  MUBWNot a    -> [a]-  MUBWAnd a b  -> [a, b]-  MUBWOr  a b  -> [a, b]-  MUShift a _  -> [a]-  MUEq  a b    -> [a, b]-  MULt  a b    -> [a, b]-  MUMux a b c  -> [a, b, c]-  MUF2B a      -> [a]-  MUD2B a      -> [a]-  MUB2F a      -> [a]-  MUB2D a      -> [a]+  MUVRef     (MUV _ _ _)     -> []+  MUVRef     (MUVArray _ a)  -> [a]+  MUVRef     (MUVExtern _ _) -> []+  MUCast     _ a             -> [a]+  MUConst    _               -> []+  MUAdd      a b             -> [a, b]+  MUSub      a b             -> [a, b]+  MUMul      a b             -> [a, b]+  MUDiv      a b             -> [a, b]+  MUMod      a b             -> [a, b]+  MUNot      a               -> [a]+  MUAnd      a               -> a+  MUBWNot    a               -> [a]+  MUBWAnd    a b             -> [a, b]+  MUBWOr     a b             -> [a, b]+  MUBWXor    a b             -> [a, b]+  MUBWShiftL a b             -> [a, b]+  MUBWShiftR a b             -> [a, b]+  MUEq       a b             -> [a, b]+  MULt       a b             -> [a, b]+  MUMux      a b c           -> [a, b, c]+  MUF2B      a               -> [a]+  MUD2B      a               -> [a]+  MUB2F      a               -> [a]+  MUB2D      a               -> [a] -- math.h:-  MUPi         -> []-  MUExp   a    -> [a]-  MULog   a    -> [a]-  MUSqrt  a    -> [a]-  MUPow   a b  -> [a, b]-  MUSin   a    -> [a]-  MUAsin  a    -> [a]-  MUCos   a    -> [a]-  MUAcos  a    -> [a]-  MUSinh  a    -> [a]-  MUCosh  a    -> [a]-  MUAsinh a    -> [a]-  MUAcosh a    -> [a]-  MUAtan  a    -> [a]-  MUAtanh a    -> [a]+  MUPi                       -> []+  MUExp      a               -> [a]+  MULog      a               -> [a]+  MUSqrt     a               -> [a]+  MUPow      a b             -> [a, b]+  MUSin      a               -> [a]+  MUAsin     a               -> [a]+  MUCos      a               -> [a]+  MUAcos     a               -> [a]+  MUSinh     a               -> [a]+  MUCosh     a               -> [a]+  MUAsinh    a               -> [a]+  MUAcosh    a               -> [a]+  MUAtan     a               -> [a]+  MUAtanh    a               -> [a]  -- | The list of all UVs that directly control the value of an expression. nearestUVs :: Hash -> UeMap -> [MUV]@@ -354,7 +364,7 @@  -- XXX can put this back after making UE map---won't be expensive. isMathHCall :: UeElem -> Bool-isMathHCall fc = +isMathHCall fc =   case fc of     MUPi        -> True     MUExp   _   -> True

@@ -1,3 +1,10 @@+atom 1.0.9    03/11/2011++- Better hardware clock support, for ensuring exact real-time behavior of the+  phases.+- Implemented a map structure for sharing between Atom expressions to improve+  the performance of the compiler (see UeMap.hs).+ atom 1.0.7    09/25/2010  - Support for using a HW clock to control the duration of phases.

@@ -1,5 +1,5 @@ name:    atom-version: 1.0.9+version: 1.0.10  category: Language, Embedded