Permalink
Browse files

More changes to get the UE map to work. Does not compile.

  • Loading branch information...
leepike committed Feb 23, 2011
1 parent a533f5d commit a642172054837875a60425d8c1f3a66df84c81eb
Showing with 124 additions and 7 deletions.
  1. +1 −0 Language/Atom/Analysis.hs
  2. +61 −4 Language/Atom/Code.hs
  3. +2 −1 Language/Atom/Language.hs
  4. +60 −2 Language/Atom/UeMap.hs
@@ -5,6 +5,7 @@ module Language.Atom.Analysis
import Language.Atom.Elaboration
import Language.Atom.Expressions
+import Language.Atom.UeMap
-- | Topologically sorts a list of expressions and subexpressions.
topo :: [UE] -> [(UE, String)]
View
@@ -18,6 +18,7 @@ import Language.Atom.Analysis
import Language.Atom.Elaboration
import Language.Atom.Expressions
import Language.Atom.Scheduling
+import Language.Atom.UeMap
-- | C code configuration parameters.
data Config = Config
@@ -112,12 +113,12 @@ cType t = case t of
Float -> "float"
Double -> "double"
-codeUE :: Config -> [(UE, String)] -> String -> (UE, String) -> String
-codeUE config ues d (ue, n) = d ++ cType (typeOf ue) ++ " " ++ n ++ " = " ++ basic operands ++ ";\n"
+codeUE :: Config -> UeMap -> String -> UeMap -> String
+codeUE config ues d (ue, n) = d ++ cType (typeOf ue) ++ " " ++ n ++ " = " ++ basic ++ ";\n"
where
operands = map (fromJust . flip lookup ues) $ ueUpstream ue
- basic :: [String] -> String
- basic operands = concat $ case ue of
+ basic :: String
+ basic = concat $ case ue of
UVRef (UV _ n _) -> [cStateName config, ".", n]
UVRef (UVArray (UA _ n _) _) -> [cStateName config, ".", n, "[", a, "]"]
UVRef (UVArray (UAExtern n _) _) -> [n, "[", a, "]"]
@@ -168,6 +169,62 @@ codeUE config ues d (ue, n) = d ++ cType (typeOf ue) ++ " " ++ n ++ " = " ++ bas
Double -> ""
_ -> error "unhandled float type"
+-- codeUE :: Config -> [(UE, String)] -> String -> (UE, String) -> String
+-- 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 _ n _) -> [cStateName config, ".", n]
+-- UVRef (UVArray (UA _ n _) _) -> [cStateName config, ".", n, "[", a, "]"]
+-- UVRef (UVArray (UAExtern n _) _) -> [n, "[", a, "]"]
+-- UVRef (UVExtern n _) -> [n]
+-- UCast _ _ -> ["(", cType (typeOf ue), ") ", a]
+-- UConst c -> [showConst c]
+-- UAdd _ _ -> [a, " + ", b]
+-- USub _ _ -> [a, " - ", b]
+-- UMul _ _ -> [a, " * ", b]
+-- UDiv _ _ -> [a, " / ", b]
+-- UMod _ _ -> [a, " % ", b]
+-- UNot _ -> ["! ", a]
+-- UAnd _ -> intersperse " && " operands
+-- UBWNot _ -> ["~ ", a]
+-- UBWAnd _ _ -> [a, " & ", b]
+-- UBWOr _ _ -> [a, " | ", b]
+-- UShift _ n -> (if n >= 0 then [a, " << ", show n] else [a, " >> ", show (negate n)])
+-- UEq _ _ -> [a, " == ", b]
+-- ULt _ _ -> [a, " < " , b]
+-- UMux _ _ _ -> [a, " ? " , b, " : ", c]
+-- UF2B _ -> ["*((", ct Word32, " *) &(", a, "))"]
+-- UD2B _ -> ["*((", ct Word64, " *) &(", a, "))"]
+-- UB2F _ -> ["*((", ct Float , " *) &(", a, "))"]
+-- UB2D _ -> ["*((", ct Double, " *) &(", a, "))"]
+-- -- math.h:
+-- UPi -> [ "M_PI" ]
+-- UExp _ -> [ "exp", f, " ( ", a, " )"]
+-- ULog _ -> [ "log", f, " ( ", a, " )"]
+-- USqrt _ -> [ "sqrt", f, " ( ", a, " )"]
+-- UPow _ _ -> [ "pow", f, " ( ", a, ", ", b, " )"]
+-- USin _ -> [ "sin", f, " ( ", a, " )"]
+-- UAsin _ -> [ "asin", f, " ( ", a, " )"]
+-- UCos _ -> [ "cos", f, " ( ", a, " )"]
+-- UAcos _ -> [ "acos", f, " ( ", a, " )"]
+-- USinh _ -> [ "sinh", f, " ( ", a, " )"]
+-- UCosh _ -> [ "cosh", f, " ( ", a, " )"]
+-- UAsinh _ -> [ "asinh", f, " ( ", a, " )"]
+-- UAcosh _ -> [ "acosh", f, " ( ", a, " )"]
+-- UAtan _ -> [ "atan", f, " ( ", a, " )"]
+-- UAtanh _ -> [ "atanh", f, " ( ", a, " )"]
+-- where
+-- ct = cType
+-- a = head operands
+-- b = operands !! 1
+-- c = operands !! 2
+-- f = case ( typeOf ue ) of
+-- Float -> "f"
+-- Double -> ""
+-- _ -> error "unhandled float type"
+
type RuleCoverage = [(Name, Int, Int)]
containMathHFunctions :: [Rule] -> Bool
@@ -82,7 +82,8 @@ atom name design = do
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] })
+ 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.
View
@@ -4,10 +4,14 @@ module Language.Atom.UeMap
( UeElem (..)
, MUV (..)
, UeMap
+ , emptyMap
, Hash
- , UeState
+ , typeOf
+-- , UeState
+ , recoverUE
, getUE
- , share
+ , newUE
+-- , share
, ueUpstream
, nearestUVs
, arrayIndices
@@ -121,12 +125,22 @@ type UeMap = (Hash, M.IntMap UeElem)
-- | Wrapped in the State Monad.
type UeState a = State UeMap a
+-- | 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) =
case M.lookup h mp of
Nothing -> error $ "Error looking up hash " ++ show h ++ " in the UE map."
Just e -> e
+-- | Put a new 'UE' in the map, unless it's already in there, and return the
+-- hash pointing to the 'UE' and a new map.
+newUE :: UE -> UeMap -> (Hash, UeMap)
+newUE ue mp = runState (share ue) mp
+
+emptyMap :: UeMap
+emptyMap = (0, M.empty)
+
-- | Create the sharing map.
share :: UE -> UeState Hash
share e =
@@ -221,6 +235,50 @@ maybeUpdate code = do
else if e == code then Just k
else Nothing) Nothing st
+-- | 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)
+-- 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)
+ 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

0 comments on commit a642172

Please sign in to comment.