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λash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index 0995dbd1fa9653708892d790e0fd4359c8f35579..cd3ba5817ca1e04384185d74dd7e50f113059d61 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/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λash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index 3945cce2a72dcf5ef55a6e87d3bb2980eab553b7..3ba262251c54131b6028b216e7ff248bc09eb18d 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/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