Permalink
Browse files

More testing needed, but sharing seems to work.

  • Loading branch information...
1 parent b2a753e commit 5066d30e19063baff40af90dc12f52021743fe50 @leepike leepike committed Feb 26, 2011
Showing with 72 additions and 63 deletions.
  1. +3 −5 Language/Atom/Elaboration.hs
  2. +7 −6 Language/Atom/Language.hs
  3. +59 −49 Language/Atom/UeMap.hs
  4. +3 −3 atom.cabal
@@ -25,13 +25,11 @@ module Language.Atom.Elaboration
, allUEs
) where
-import Debug.Trace
-
import Control.Monad.Trans
import Data.Function (on)
import Data.List
import Data.Char
-import qualified Control.Monad.State as S
+import qualified Control.Monad.State.Strict as S
import Language.Atom.Expressions hiding (typeOf)
import Language.Atom.UeMap
@@ -263,7 +261,7 @@ elaborate st name atom = do
putStrLn "ERROR: Design contains no rules. Nothing to do."
return Nothing
else do
- mapM_ (checkEnable st) rules
+ mapM_ (checkEnable st2) rules
ok <- mapM checkAssignConflicts rules
return (if and ok
then Just ( st2
@@ -285,7 +283,7 @@ trimState a = case a of
-- | Checks that a rule will not be trivially disabled.
checkEnable :: UeMap -> Rule -> IO ()
checkEnable st rule
- | trace (show (ruleEnable rule) ++ ":" ++ show (fst $ newUE (ubool False) st) ) $ ruleEnable rule == (fst $ newUE (ubool False) st) =
+ | ruleEnable rule == (fst $ newUE (ubool False) st) =
putStrLn $ "WARNING: Rule will never execute: " ++ show rule
| otherwise = return ()
View
@@ -105,7 +105,7 @@ period n atom = do
-- | Returns the execution period of the current scope.
getPeriod :: Atom Int
getPeriod = do
- (st, (g, _)) <- get
+ (_, (g, _)) <- get
return $ gPeriod g
phase' :: (Int -> Phase) -> Int -> Atom a -> Atom a
@@ -141,15 +141,15 @@ exactPhase n a = phase' ExactPhase n a
-- | Returns the phase of the current scope.
getPhase :: Atom Int
getPhase = do
- (st, (g, _)) <- get
+ (_, (g, _)) <- get
return $ case gPhase g of
MinPhase ph -> ph
ExactPhase ph -> ph
-- | Returns the current atom hierarchical path.
path :: Atom String
path = do
- (st, (_, atom)) <- get
+ (_, (_, atom)) <- get
return $ atomName atom
-- | Local boolean variable declaration.
@@ -321,9 +321,10 @@ nextCoverage = do
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.
--- Parent enabling conditions can disable assertions, but period and phase constraints do not.
--- Assertion names should be globally unique.
+-- | An assertions checks that an E Bool is true. Assertions are checked
+-- between the execution of every rule. Parent enabling conditions can
+-- disable assertions, but period and phase constraints do not. Assertion
+-- names should be globally unique.
assert :: Name -> E Bool -> Atom ()
assert name check = do
(st, (g, atom)) <- get
View
@@ -20,7 +20,7 @@ module Language.Atom.UeMap
, isMathHCall
) where
-import Control.Monad.State
+import Control.Monad.State.Strict
import qualified Data.IntMap as M
import Data.Maybe
import Data.List (nub)
@@ -48,43 +48,43 @@ newUV uv mp =
-- | 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
+ = 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
+ | 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
-- 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
@@ -211,7 +211,7 @@ binOp (e0,e1) code = do
triOp :: (UE, UE, UE) -> (Hash -> Hash -> Hash -> UeElem) -> UeState Hash
triOp (e0,e1,e2) code = do
- h0 <- share e0
+ h0 <- share e0
h1 <- share e1
h2 <- share e2
maybeUpdate (code h0 h1 h2)
@@ -227,24 +227,34 @@ listOp es code = do
-- its hash value. Otherwise, update the map and return the new hash value
-- for the inserted element.
maybeUpdate :: UeElem -> UeState Hash
-maybeUpdate code = do
+maybeUpdate e = do
st <- get
- case getHash code (snd st) of
- Nothing -> update code st
+-- case getHash e (snd st) of
+ case getHash e (M.assocs $ snd st) of
+ Nothing -> update e st
Just h -> return h
where
-- Update the map.
update :: UeElem -> UeMap -> UeState Hash
- update code st = do let hash = fst st + 1
- put (hash, M.insert hash code (snd st))
- return hash
- -- Lookup a hash value, returning 'Nothing' if no hash exists in the map and
- -- 'Just' the hash value otherwise.
- getHash :: UeElem -> M.IntMap UeElem -> Maybe Hash
- getHash e st =
- M.foldWithKey (\k code m -> if isJust m then m
- else if e == code then Just k
- else Nothing) Nothing st
+ update e st = do let hash = fst st + 1
+ put (hash, M.insert hash e (snd st))
+ return hash
+
+-- Lookup an elem, returning 'Nothing' if no hash exists in the map and 'Just'
+-- the hash value otherwise.
+getHash :: UeElem -> [(Hash, UeElem)] -> Maybe Hash
+getHash e [] = Nothing
+getHash e ((k,e'):_) | e == e' = Just k
+getHash e (_:es) | otherwise = getHash e es
+
+ -- M.foldWithKey (\k code m -> if isJust m then m
+ -- else if e == code then Just k
+ -- else Nothing) Nothing st
+-- getHash :: UeElem -> M.IntMap UeElem -> Maybe Hash
+-- getHash e st =
+-- M.foldWithKey (\k code m -> if isJust m then m
+-- else if e == code then Just k
+-- else Nothing) Nothing st
-- | Get a 'UE' back out of the 'UeMap'.
recoverUE :: UeMap -> Hash -> UE
View
@@ -34,7 +34,7 @@ extra-source-files:
library
build-depends:
base >= 4.0 && < 5,
- mtl >= 1.1.0.1 && < 1.2,
+ mtl >= 1.1.0.1,
process >= 1.0.1.1 && < 1.2,
syb >= 0.1.0.0,
containers >= 0.4
@@ -56,8 +56,8 @@ library
extensions: GADTs, DeriveDataTypeable
if impl(ghc > 6.8)
- ghc-options: -fwarn-tabs
- ghc-options: -W
+ ghc-options: -fwarn-tabs -O2
+ ghc-options: -W -O2
source-repository head
type: git

0 comments on commit 5066d30

Please sign in to comment.