X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=c%CE%BBash%2FCLasH%2FNormalize.hs;h=6096c65bb3c59bbc2105726b54c0d178587fce0c;hb=4c63601269c7097e2177c547dc36d4edecc1c648;hp=722461037a3e146b61a139cea1f432e0dabbdb5d;hpb=d30d9fe36698d9d9b5e44099fba9ba090e54064f;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..6096c65 100644
--- "a/c\316\273ash/CLasH/Normalize.hs"
+++ "b/c\316\273ash/CLasH/Normalize.hs"
@@ -467,22 +467,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 =