X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=NormalizeTools.hs;h=5ea3a7db8ab852fce0a7dd8529573e718ff2e7eb;hb=8153abb4f08f21e097eca9bd38fa6155675be40b;hp=8e57ba8f2ec2446301ebcf22ec83e03f577470b7;hpb=3ad8feb4ca1eecfb53bed973d7e0f1c3b4145d0f;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/NormalizeTools.hs b/NormalizeTools.hs index 8e57ba8..5ea3a7d 100644 --- 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 Data.Accessor.MonadState as MonadState -- GHC API import CoreSyn @@ -32,6 +33,8 @@ import Outputable ( showSDoc, ppr, nest ) -- 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, @@ -119,6 +122,11 @@ subeverywhere trans (App a b) = do 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 @@ -151,7 +159,7 @@ subeverywhere trans (Cast expr ty) = do expr' <- trans expr return $ Cast expr' ty -subeverywhere trans expr = error $ "NormalizeTools.subeverywhere Unsupported expression: " ++ show expr +subeverywhere trans expr = error $ "\nNormalizeTools.subeverywhere: Unsupported expression: " ++ show expr -- Apply the given transformation to all expressions, except for direct -- arguments of an application @@ -229,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 -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)