Move flattenLets from Normalize to CoreTools.

[matthijs/master-project/cλash.git] / cλash / CLasH / Utils / Core / CoreTools.hs

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index e3021adc95e0807109748ad42acc6dacefe03bb6..21c5e1465f5a052a580ea64fce150a08ac2ab01b 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/CLasH/Utils/Core/CoreTools.hs
@@ -23,12 +23,14 @@ import qualified OccName
 import qualified Type
 import qualified Id
 import qualified TyCon
 import qualified Type
 import qualified Id
 import qualified TyCon

+import qualified DataCon

 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc
 import qualified CoreSyn
 import qualified Var
 import qualified TysWiredIn
 import qualified Bag
 import qualified DynFlags
 import qualified SrcLoc
 import qualified CoreSyn
 import qualified Var

+import qualified IdInfo

 import qualified VarSet
 import qualified Unique
 import qualified CoreUtils
 import qualified VarSet
 import qualified Unique
 import qualified CoreUtils


@@ -41,6 +43,9 @@ import CLasH.Utils.GhcTools
 import CLasH.Utils.HsTools
 import CLasH.Utils.Pretty
 
 import CLasH.Utils.HsTools
 import CLasH.Utils.Pretty
 

+-- | A single binding, used as a shortcut to simplify type signatures.
+type Binding = (CoreSyn.CoreBndr, CoreSyn.CoreExpr)
+

 -- | Evaluate a core Type representing type level int from the tfp
 -- library to a real int.
 eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int
 -- | Evaluate a core Type representing type level int from the tfp
 -- library to a real int.
 eval_tfp_int :: HscTypes.HscEnv -> Type.Type -> Int


@@ -254,6 +259,22 @@ reduceCoreListToHsList cores app@(CoreSyn.App _ _) = do {
 
 reduceCoreListToHsList _ _ = return []
 
 
 reduceCoreListToHsList _ _ = return []
 

+-- Is the given var the State data constructor?
+isStateCon :: Var.Var -> Bool
+isStateCon var = do
+  -- See if it is a DataConWrapId (not DataConWorkId, since State is a
+  -- newtype).
+  case Id.idDetails var of
+    IdInfo.DataConWrapId dc -> 
+      -- See if the datacon is the State datacon from the State type.
+      let tycon = DataCon.dataConTyCon dc
+          tyname = Name.getOccString tycon
+          dcname = Name.getOccString dc
+      in case (tyname, dcname) of
+        ("State", "State") -> True
+        _ -> False
+    _ -> False
+

 -- | Is the given type a State type?
 isStateType :: Type.Type -> Bool
 -- Resolve any type synonyms remaining
 -- | Is the given type a State type?
 isStateType :: Type.Type -> Bool
 -- Resolve any type synonyms remaining


@@ -277,6 +298,21 @@ hasStateType expr = case getType expr of
   Just ty -> isStateType ty
 
 
   Just ty -> isStateType ty
 
 

+-- | Flattens nested lets into a single list of bindings. The expression
+--   passed does not have to be a let expression, if it isn't an empty list of
+--   bindings is returned.
+flattenLets ::
+  CoreSyn.CoreExpr -- ^ The expression to flatten.
+  -> ([Binding], CoreSyn.CoreExpr) -- ^ The bindings and resulting expression.
+flattenLets (CoreSyn.Let binds expr) = 
+  (bindings ++ bindings', expr')
+  where
+    -- Recursively flatten the contained expression
+    (bindings', expr') =flattenLets expr
+    -- Flatten our own bindings to remove the Rec / NonRec constructors
+    bindings = CoreSyn.flattenBinds [binds]
+flattenLets expr = ([], expr)
+

 -- | A class of things that (optionally) have a core Type. The type is
 -- optional, since Type expressions don't have a type themselves.
 class TypedThing t where
 -- | A class of things that (optionally) have a core Type. The type is
 -- optional, since Type expressions don't have a type themselves.
 class TypedThing t where