X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize%2FNormalizeTools.hs;h=0ae958abf456198c82ad7fdf3ed97394dd302441;hb=fcadaad2e47e5f6cba4b9f7d4341477b8fe74158;hp=920d28bdcefa171f8bfa3437f727fa3df25f5dbf;hpb=ec4378a8a765c5a064b5cbed347b40c353c778a0;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs" "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
index 920d28b..0ae958a 100644
--- "a/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
+++ "b/c\316\273ash/CLasH/Normalize/NormalizeTools.hs"
@@ -2,7 +2,7 @@
 -- 
 -- This module provides functions for program transformations.
 --
-module NormalizeTools where
+module CLasH.Normalize.NormalizeTools where
 -- Standard modules
 import Debug.Trace
 import qualified List
@@ -34,18 +34,22 @@ import qualified HscTypes
 import Outputable ( showSDoc, ppr, nest )
 
 -- Local imports
-import NormalizeTypes
-import Pretty
-import VHDLTypes
-import qualified VHDLTools
+import CLasH.Normalize.NormalizeTypes
+import CLasH.Translator.TranslatorTypes
+import CLasH.Utils.Pretty
+import CLasH.VHDL.VHDLTypes
+import qualified CLasH.VHDL.VHDLTools as 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,
 -- since the Unique is also stored in the name, but this ensures variable
 -- names are unique in the output).
 mkInternalVar :: String -> Type.Type -> TransformMonad Var.Var
-mkInternalVar str ty = do
-  uniq <- mkUnique
+mkInternalVar str ty = Trans.lift (mkInternalVar' str ty)
+  
+mkInternalVar' :: String -> Type.Type -> TransformSession Var.Var
+mkInternalVar' str ty = do
+  uniq <- mkUnique'
   let occname = OccName.mkVarOcc (str ++ show uniq)
   let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
   return $ Var.mkLocalVar IdInfo.VanillaId name ty IdInfo.vanillaIdInfo
@@ -55,8 +59,11 @@ mkInternalVar str ty = do
 -- since the Unique is also stored in the name, but this ensures variable
 -- names are unique in the output).
 mkTypeVar :: String -> Type.Kind -> TransformMonad Var.Var
-mkTypeVar str kind = do
-  uniq <- mkUnique
+mkTypeVar str kind = Trans.lift (mkTypeVar' str kind)
+  
+mkTypeVar' :: String -> Type.Kind -> TransformSession Var.Var
+mkTypeVar' str kind = do
+  uniq <- mkUnique'
   let occname = OccName.mkVarOcc (str ++ show uniq)
   let name = Name.mkInternalName uniq occname SrcLoc.noSrcSpan
   return $ Var.mkTyVar name kind
@@ -65,8 +72,11 @@ mkTypeVar str kind = do
 -- works for both value and type level expressions, so it can return a Var or
 -- TyVar (which is just an alias for Var).
 mkBinderFor :: CoreExpr -> String -> TransformMonad Var.Var
-mkBinderFor (Type ty) string = mkTypeVar string (Type.typeKind ty)
-mkBinderFor expr string = mkInternalVar string (CoreUtils.exprType expr)
+mkBinderFor expr string = Trans.lift (mkBinderFor' expr string)
+
+mkBinderFor' :: CoreExpr -> String -> TransformSession Var.Var
+mkBinderFor' (Type ty) string = mkTypeVar' string (Type.typeKind ty)
+mkBinderFor' expr string = mkInternalVar' string (CoreUtils.exprType expr)
 
 -- Creates a reference to the given variable. This works for both a normal
 -- variable as well as a type variable
@@ -221,11 +231,14 @@ change val = do
 
 -- Create a new Unique
 mkUnique :: TransformMonad Unique.Unique
-mkUnique = Trans.lift $ do
-    us <- getA tsUniqSupply 
-    let (us', us'') = UniqSupply.splitUniqSupply us
-    putA tsUniqSupply us'
-    return $ UniqSupply.uniqFromSupply us''
+mkUnique = Trans.lift $ mkUnique'
+
+mkUnique' :: TransformSession Unique.Unique    
+mkUnique' = do
+  us <- getA tsUniqSupply 
+  let (us', us'') = UniqSupply.splitUniqSupply us
+  putA tsUniqSupply us'
+  return $ UniqSupply.uniqFromSupply us''
 
 -- Replace each of the binders given with the coresponding expressions in the
 -- given expression.
@@ -246,14 +259,6 @@ substitute ((b, e):subss) expr = substitute subss' expr'
     -- substitutions
     subss' = map (Arrow.second (CoreSubst.substExpr subs)) subss
 
--- Run a given TransformSession. Used mostly to setup the right calls and
--- an initial state.
-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