Add predicates for testing representability of types.

[matthijs/master-project/cλash.git] / NormalizeTools.hs

diff --git a/NormalizeTools.hs b/NormalizeTools.hs
index c20c58349491ee5aa75a5fe8348fe1fa4623ca13..5ea3a7db8ab852fce0a7dd8529573e718ff2e7eb 100644 (file)
--- a/NormalizeTools.hs
+++ b/NormalizeTools.hs
@@ -14,6 +14,7 @@ import qualified Control.Monad.Trans.Writer as Writer
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor
 import qualified "transformers" Control.Monad.Trans as Trans
 import qualified Data.Map as Map
 import Data.Accessor

+import Data.Accessor.MonadState as MonadState

 
 -- GHC API
 import CoreSyn
 
 -- GHC API
 import CoreSyn


@@ -32,6 +33,8 @@ import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
 import NormalizeTypes
 
 -- Local imports
 import NormalizeTypes

+import Pretty
+import qualified VHDLTools

 
 -- Create a new internal var with the given name and type. A Unique is
 -- appended to the given name, to ensure uniqueness (not strictly neccesary,
 
 -- Create a new internal var with the given name and type. A Unique is
 -- appended to the given name, to ensure uniqueness (not strictly neccesary,


@@ -119,6 +122,11 @@ subeverywhere trans (App a b) = do
   b' <- trans b
   return $ App a' b'
 
   b' <- trans b
   return $ App a' b'
 

+subeverywhere trans (Let (NonRec b bexpr) expr) = do
+  bexpr' <- trans bexpr
+  expr' <- trans expr
+  return $ Let (NonRec b bexpr') expr'
+

 subeverywhere trans (Let (Rec binds) expr) = do
   expr' <- trans expr
   binds' <- mapM transbind binds
 subeverywhere trans (Let (Rec binds) expr) = do
   expr' <- trans expr
   binds' <- mapM transbind binds


@@ -147,7 +155,11 @@ subeverywhere trans (Var x) = return $ Var x
 subeverywhere trans (Lit x) = return $ Lit x
 subeverywhere trans (Type x) = return $ Type x
 
 subeverywhere trans (Lit x) = return $ Lit x
 subeverywhere trans (Type x) = return $ Type x
 

-subeverywhere trans expr = error $ "NormalizeTools.subeverywhere Unsupported expression: " ++ show expr
+subeverywhere trans (Cast expr ty) = do
+  expr' <- trans expr
+  return $ Cast expr' ty
+
+subeverywhere trans expr = error $ "\nNormalizeTools.subeverywhere: Unsupported expression: " ++ show expr

 
 -- Apply the given transformation to all expressions, except for direct
 -- arguments of an application
 
 -- Apply the given transformation to all expressions, except for direct
 -- arguments of an application


@@ -225,5 +237,9 @@ substitute ((b, e):subss) expr = substitute subss' expr'
 -- Run a given TransformSession. Used mostly to setup the right calls and
 -- an initial state.
 runTransformSession :: UniqSupply.UniqSupply -> TransformSession a -> a
 -- Run a given TransformSession. Used mostly to setup the right calls and
 -- an initial state.
 runTransformSession :: UniqSupply.UniqSupply -> TransformSession a -> a

-runTransformSession uniqSupply session = State.evalState session initState
-                       where initState = TransformState uniqSupply Map.empty VarSet.emptyVarSet
+runTransformSession uniqSupply session = State.evalState session (emptyTransformState uniqSupply)
+
+-- Is the given expression representable at runtime, based on the type?
+isRepr :: CoreSyn.CoreExpr -> TransformMonad Bool
+isRepr (Type ty) = return False
+isRepr expr = Trans.lift $ MonadState.lift tsType $ VHDLTools.isReprType (CoreUtils.exprType expr)