From: Matthijs Kooijman <m.kooijman@student.utwente.nl>
Date: Fri, 14 Aug 2009 13:47:28 +0000 (+0200)
Subject: Add mkNonRecLets and use it.
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=0e3e9200536bf038c77f43e43a678d408afee466;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Add mkNonRecLets and use it.

This function creates a bunch nested non-recursive lets. It is similar to
MkCore.mkCoreLets, but works only for non-recursive lets, which makes it a
bit more elegant in usage.
---

diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs"
index 0995dbd..cd3ba58 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -123,15 +123,12 @@ letderec expr@(Let (Rec binds) res) = case liftable of
   -- Nothing is liftable, just return
   [] -> return expr
   -- Something can be lifted, generate a new let expression
-  _ -> change $ MkCore.mkCoreLets newbinds res
+  _ -> change $ mkNonRecLets liftable (Let (Rec nonliftable) res)
   where
     -- Make a list of all the binders bound in this recursive let
     bndrs = map fst binds
     -- See which bindings are liftable
     (liftable, nonliftable) = List.partition canlift binds
-    -- Create nonrec bindings for each liftable binding and a single recursive
-    -- binding for all others
-    newbinds = (map (uncurry NonRec) liftable) ++ [Rec nonliftable]
     -- Any expression that does not use any of the binders in this recursive let
     -- can be lifted into a nonrec let. It can't use its own binder either,
     -- since that would mean the binding is self-recursive and should be in a
@@ -231,7 +228,7 @@ letmerge, letmergetop :: Transform
 letmerge expr@(Let _ _) = do
   let (binds, res) = flattenLets expr
   binds' <- domerge binds
-  return $ MkCore.mkCoreLets (map (uncurry NonRec) binds') res
+  return $ mkNonRecLets binds' res
   where
     domerge :: [(CoreBndr, CoreExpr)] -> TransformMonad [(CoreBndr, CoreExpr)]
     domerge [] = return []
diff --git "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs" "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
index 3945cce..3ba2622 100644
--- "a/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
+++ "b/c\316\273ash/CLasH/Utils/Core/CoreTools.hs"
@@ -36,6 +36,7 @@ import qualified Unique
 import qualified CoreUtils
 import qualified CoreFVs
 import qualified Literal
+import qualified MkCore
 
 -- Local imports
 import CLasH.Translator.TranslatorTypes
@@ -311,6 +312,14 @@ flattenLets (CoreSyn.Let (CoreSyn.NonRec bndr expr) res) =
     (bindings, res') = flattenLets res
 flattenLets expr = ([], expr)
 
+-- | Create bunch of nested non-recursive let expressions from the given
+-- bindings. The first binding is bound at the highest level (and thus
+-- available in all other bindings).
+mkNonRecLets :: [Binding] -> CoreSyn.CoreExpr -> CoreSyn.CoreExpr
+mkNonRecLets bindings expr = MkCore.mkCoreLets binds expr
+  where
+    binds = map (uncurry CoreSyn.NonRec) bindings
+
 -- | 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