Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project

* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Don't generate a state proc for an empty state.
  Make splitNormalized work for non-recursive lets.
  Add and use splitNormalized helper function.

diff --git a/cλash/CLasH/Normalize.hs b/cλash/CLasH/Normalize.hs
index ec3ed56bde3da6b606a1855e0dfdd34d50bca922..1d40f92d52f7b94989fc9215bcfd15723a9001e0 100644 (file)
--- a/cλash/CLasH/Normalize.hs
+++ b/cλash/CLasH/Normalize.hs
@@ -4,7 +4,7 @@
 -- top level function "normalize", and defines the actual transformation passes that
 -- are performed.
 --
-module CLasH.Normalize (getNormalized, normalizeExpr) where
+module CLasH.Normalize (getNormalized, normalizeExpr, splitNormalized) where
 
 -- Standard modules
 import Debug.Trace
@@ -589,3 +589,31 @@ getBinding bndr = Utils.makeCached bndr tsBindings $ do
   -- If the binding isn't in the "cache" (bindings map), then we can't create
   -- it out of thin air, so return an error.
   error $ "Normalize.getBinding: Unknown function requested: " ++ show bndr
+
+-- | Split a normalized expression into the argument binders, top level
+--   bindings and the result binder.
+splitNormalized ::
+  CoreExpr -- ^ The normalized expression
+  -> ([CoreBndr], [Binding], CoreBndr)
+splitNormalized expr = (args, binds, res)
+  where
+    (args, letexpr) = CoreSyn.collectBinders expr
+    (binds, resexpr) = flattenLets letexpr
+    res = case resexpr of 
+      (Var x) -> x
+      _ -> error $ "Normalize.splitNormalized: Not in normal form: " ++ pprString expr ++ "\n"
+
+-- | 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 ::
+  CoreExpr -- ^ The expression to flatten.
+  -> ([Binding], CoreExpr) -- ^ The bindings and resulting expression.
+flattenLets (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)

diff --git a/cλash/CLasH/Utils/Core/CoreTools.hs b/cλash/CLasH/Utils/Core/CoreTools.hs
index 48ca948c3baf39dfc4edc97ea7fd578ff6d48999..d8f4289d28b25253544126ba0424f90f6fc842de 100644 (file)
--- a/cλash/CLasH/Utils/Core/CoreTools.hs
+++ b/cλash/CLasH/Utils/Core/CoreTools.hs
@@ -43,6 +43,9 @@ import CLasH.Utils.GhcTools
 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

diff --git a/cλash/CLasH/VHDL/Generate.hs b/cλash/CLasH/VHDL/Generate.hs
index 99d5d270dc976ef84abe470bac6249a02db1feaa..0be4f60be94c58bec17826191353d832ad83482a 100644 (file)
--- a/cλash/CLasH/VHDL/Generate.hs
+++ b/cλash/CLasH/VHDL/Generate.hs
@@ -44,12 +44,10 @@ getEntity ::
 
 getEntity fname = Utils.makeCached fname tsEntities $ do
       expr <- Normalize.getNormalized fname
-      -- Strip off lambda's, these will be arguments
-      let (args, letexpr) = CoreSyn.collectBinders expr
+      -- Split the normalized expression
+      let (args, binds, res) = Normalize.splitNormalized expr
       -- Generate ports for all non-empty types
       args' <- catMaybesM $ mapM mkMap args
-      -- There must be a let at top level 
-      let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr
       -- TODO: Handle Nothing
       res' <- mkMap res
       count <- getA tsEntityCounter 
@@ -113,12 +111,12 @@ getArchitecture ::
 
 getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   expr <- Normalize.getNormalized fname
+  -- Split the normalized expression
+  let (args, binds, res) = Normalize.splitNormalized expr
+  
+  -- Get the entity for this function
   signature <- getEntity fname
   let entity_id = ent_id signature
-  -- Strip off lambda's, these will be arguments
-  let (args, letexpr) = CoreSyn.collectBinders expr
-  -- There must be a let at top level 
-  let (CoreSyn.Let (CoreSyn.Rec binds) (CoreSyn.Var res)) = letexpr
 
   -- Create signal declarations for all binders in the let expression, except
   -- for the output port (that will already have an output port declared in
@@ -131,9 +129,9 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
   let (in_state_maybes, out_state_maybes) = unzip state_vars
   let (statementss, used_entitiess) = unzip sms
   -- Create a state proc, if needed
-  let state_proc = case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
-        ([in_state], [out_state]) -> [AST.CSPSm $ mkStateProcSm (in_state, out_state)]
-        ([], []) -> []
+  state_proc <- case (Maybe.catMaybes in_state_maybes, Maybe.catMaybes out_state_maybes) of
+        ([in_state], [out_state]) -> mkStateProcSm (in_state, out_state)
+        ([], []) -> return []
         (ins, outs) -> error $ "Weird use of state in " ++ show fname ++ ". In: " ++ show ins ++ " Out: " ++ show outs
   -- Join the create statements and the (optional) state_proc
   let statements = concat statementss ++ state_proc
@@ -164,9 +162,12 @@ getArchitecture fname = Utils.makeCached fname tsArchitectures $ do
 
 mkStateProcSm :: 
   (CoreSyn.CoreBndr, CoreSyn.CoreBndr) -- ^ The current and new state variables
-  -> AST.ProcSm -- ^ The resulting statement
-mkStateProcSm (old, new) =
-  AST.ProcSm label [clk] [statement]
+  -> TranslatorSession [AST.ConcSm] -- ^ The resulting statements
+mkStateProcSm (old, new) = do
+  nonempty <- hasNonEmptyType old 
+  if nonempty 
+    then return [AST.CSPSm $ AST.ProcSm label [clk] [statement]]
+    else return []
   where
     label       = mkVHDLBasicId $ "state"
     clk         = mkVHDLBasicId "clock"

diff --git a/cλash/CLasH/VHDL/Testbench.hs b/cλash/CLasH/VHDL/Testbench.hs
index 98c5b4686417e72e266f0d068b62678f7080d437..84f550aaf7da15fcaef1cd9cc7a508845a9eecc3 100644 (file)
--- a/cλash/CLasH/VHDL/Testbench.hs
+++ b/cλash/CLasH/VHDL/Testbench.hs
@@ -129,7 +129,10 @@ createStimulans ::
 
 createStimulans expr cycl = do 
   -- There must be a let at top level 
-  (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) <- normalizeExpr ("test input #" ++ show cycl) expr
+  expr <- normalizeExpr ("test input #" ++ show cycl) expr
+  -- Split the normalized expression. It can't have a function type, so match
+  -- an empty list of argument binders
+  let ([], binds, res) = splitNormalized expr
   (stimulansbindss, useds) <- unzipM $ Monad.mapM mkConcSm binds
   sig_dec_maybes <- mapM (mkSigDec . fst) (filter ((/=res).fst) binds)
   let sig_decs = map (AST.BDISD) (Maybe.catMaybes $ sig_dec_maybes)