X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize.hs;h=e69db2c4421c0f018bfab8a1aac78fc0a4c91ac3;hb=28fc9c7226af6124a2c72c1f23c8e1b6cf196e18;hp=722461037a3e146b61a139cea1f432e0dabbdb5d;hpb=b2967df7f237e5b4db15d069895ca01c31712d9e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git "a/c\316\273ash/CLasH/Normalize.hs" "b/c\316\273ash/CLasH/Normalize.hs"
index 7224610..e69db2c 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -102,10 +102,11 @@ letrectop = everywhere ("letrec", letrec)
 --------------------------------
 letsimpl, letsimpltop :: Transform
 -- Put the "in ..." value of a let in its own binding, but not when the
--- expression is applicable (to prevent loops with inlinefun).
-letsimpl expr@(Let (Rec binds) res) | not $ is_applicable expr = do
+-- expression is already a local variable, or not representable (to prevent loops with inlinenonrep).
+letsimpl expr@(Let (Rec binds) res) = do
+  repr <- isRepr res
   local_var <- Trans.lift $ is_local_var res
-  if not local_var
+  if not local_var && repr
     then do
       -- If the result is not a local var already (to prevent loops with
       -- ourselves), extract it.
@@ -467,22 +468,28 @@ normalizeModule ::
   HscTypes.HscEnv
   -> UniqSupply.UniqSupply -- ^ A UniqSupply we can use
   -> [(CoreBndr, CoreExpr)]  -- ^ All bindings we know (i.e., in the current module)
+  -> [CoreExpr]
   -> [CoreBndr]  -- ^ The bindings to generate VHDL for (i.e., the top level bindings)
   -> [Bool] -- ^ For each of the bindings to generate VHDL for, if it is stateful
-  -> ([(CoreBndr, CoreExpr)], TypeState) -- ^ The resulting VHDL
+  -> ([(CoreBndr, CoreExpr)], [(CoreBndr, CoreExpr)], TypeState) -- ^ The resulting VHDL
 
-normalizeModule env uniqsupply bindings generate_for statefuls = runTransformSession env uniqsupply $ do
+normalizeModule env uniqsupply bindings testexprs generate_for statefuls = runTransformSession env uniqsupply $ do
+  testbinds <- mapM (\x -> do { v <- mkBinderFor' x "test" ; return (v,x) } ) testexprs
+  let testbinders = (map fst testbinds)
   -- Put all the bindings in this module in the tsBindings map
-  putA tsBindings (Map.fromList bindings)
+  putA tsBindings (Map.fromList (bindings ++ testbinds))
   -- (Recursively) normalize each of the requested bindings
-  mapM normalizeBind generate_for
+  mapM normalizeBind (generate_for ++ testbinders)
   -- Get all initial bindings and the ones we produced
   bindings_map <- getA tsBindings
   let bindings = Map.assocs bindings_map
-  normalized_bindings <- getA tsNormalized
+  normalized_binders' <- getA tsNormalized
+  let normalized_binders = VarSet.delVarSetList normalized_binders' testbinders
+  let ret_testbinds = zip testbinders (Maybe.catMaybes $ map (\x -> lookup x bindings) testbinders)
+  let ret_binds = filter ((`VarSet.elemVarSet` normalized_binders) . fst) bindings
   typestate <- getA tsType
   -- But return only the normalized bindings
-  return $ (filter ((flip VarSet.elemVarSet normalized_bindings) . fst) bindings, typestate)
+  return $ (ret_binds, ret_testbinds, typestate)
 
 normalizeBind :: CoreBndr -> TransformSession ()
 normalizeBind bndr =