projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Moved to new GHC API (6.11). Also use vhdl package for the VHDL AST
[matthijs/master-project/cλash.git]
/
NormalizeTools.hs
diff --git
a/NormalizeTools.hs
b/NormalizeTools.hs
index 85fae47e8f66a19865f281ee25e642d9dca1f16f..920d28bdcefa171f8bfa3437f727fa3df25f5dbf 100644
(file)
--- a/
NormalizeTools.hs
+++ b/
NormalizeTools.hs
@@
-30,11
+30,13
@@
import qualified IdInfo
import qualified CoreUtils
import qualified CoreSubst
import qualified VarSet
import qualified CoreUtils
import qualified CoreSubst
import qualified VarSet
+import qualified HscTypes
import Outputable ( showSDoc, ppr, nest )
-- Local imports
import NormalizeTypes
import Pretty
import Outputable ( showSDoc, ppr, nest )
-- Local imports
import NormalizeTypes
import Pretty
+import VHDLTypes
import qualified VHDLTools
-- Create a new internal var with the given name and type. A Unique is
import qualified VHDLTools
-- Create a new internal var with the given name and type. A Unique is
@@
-46,7
+48,7
@@
mkInternalVar str ty = do
uniq <- mkUnique
let occname = OccName.mkVarOcc (str ++ show uniq)
let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
uniq <- mkUnique
let occname = OccName.mkVarOcc (str ++ show uniq)
let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
- return $ Var.mkLocal
IdVar
name ty IdInfo.vanillaIdInfo
+ return $ Var.mkLocal
Var IdInfo.VanillaId
name ty IdInfo.vanillaIdInfo
-- Create a new type variable with the given name and kind. A Unique is
-- appended to the given name, to ensure uniqueness (not strictly neccesary,
-- Create a new type variable with the given name and kind. A Unique is
-- appended to the given name, to ensure uniqueness (not strictly neccesary,
@@
-77,7
+79,7
@@
cloneVar v = do
uniq <- mkUnique
-- Swap out the unique, and reset the IdInfo (I'm not 100% sure what it
-- contains, but vannillaIdInfo is always correct, since it means "no info").
uniq <- mkUnique
-- Swap out the unique, and reset the IdInfo (I'm not 100% sure what it
-- contains, but vannillaIdInfo is always correct, since it means "no info").
- return $ Var.lazySet
Var
IdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
+ return $ Var.lazySetIdInfo (Var.setVarUnique v uniq) IdInfo.vanillaIdInfo
-- Creates a new function with the same name as the given binder (but with a
-- new unique) and with the given function body. Returns the new binder for
-- Creates a new function with the same name as the given binder (but with a
-- new unique) and with the given function body. Returns the new binder for
@@
-104,15
+106,15
@@
applyboth first (name, second) expr = do
-- Apply the second
(expr'', changed) <- Writer.listen $ second expr'
if Monoid.getAny $
-- Apply the second
(expr'', changed) <- Writer.listen $ second expr'
if Monoid.getAny $
-
--
trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
+
--
trace ("Trying to apply transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
changed
then
-- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
changed
then
-- trace ("Applying transform " ++ name ++ " to:\n" ++ showSDoc (nest 4 $ ppr expr') ++ "\nType: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr') ++ "\n") $
-
--
trace ("Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
+
--
trace ("Result of applying " ++ name ++ ":\n" ++ showSDoc (nest 4 $ ppr expr'') ++ "\n" ++ "Type: \n" ++ (showSDoc $ nest 4 $ ppr $ CoreUtils.exprType expr'') ++ "\n" ) $
applyboth first (name, second) $
expr''
else
applyboth first (name, second) $
expr''
else
-
--
trace ("No changes") $
+
--
trace ("No changes") $
return expr''
-- Apply the given transformation to all direct subexpressions (only), not the
return expr''
-- Apply the given transformation to all direct subexpressions (only), not the
@@
-246,10
+248,19
@@
substitute ((b, e):subss) expr = substitute subss' expr'
-- Run a given TransformSession. Used mostly to setup the right calls and
-- an initial state.
-- 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 (emptyTransformState uniqSupply)
+runTransformSession :: HscTypes.HscEnv -> UniqSupply.UniqSupply -> TransformSession a -> a
+runTransformSession env uniqSupply session = State.evalState session emptyTransformState
+ where
+ emptyTypeState = TypeState Map.empty [] Map.empty Map.empty env
+ emptyTransformState = TransformState uniqSupply Map.empty VarSet.emptyVarSet emptyTypeState
-- 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)
-- 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)
+
+is_local_var :: CoreSyn.CoreExpr -> TransformSession Bool
+is_local_var (CoreSyn.Var v) = do
+ bndrs <- getGlobalBinders
+ return $ not $ v `elem` bndrs
+is_local_var _ = return False