Really revert all of the recent rotating changes.

[matthijs/master-project/cλash.git] / Flatten.hs

diff --git a/Flatten.hs b/Flatten.hs
index e434f2e0862f1d5adffa272298f267d22cb46b5a..d25ef73aceabb2feec43007b1a469b267a72ce09 100644 (file)
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -54,11 +54,10 @@ markSignal use id = markSignals use [id]
 -- | Flatten a haskell function
 flattenFunction ::
   HsFunction                      -- ^ The function to flatten
-  -> CoreBind                     -- ^ The function value
+  -> (CoreBndr, CoreExpr)         -- ^ The function value
   -> FlatFunction                 -- ^ The resulting flat function
 
-flattenFunction _ (Rec _) = error "Recursive binders not supported"
-flattenFunction hsfunc bind@(NonRec var expr) =
+flattenFunction hsfunc (var, expr) =
   FlatFunction args res defs sigs
   where
     init_state        = ([], [], 0)
@@ -169,7 +168,7 @@ flattenExpr binds var@(Var id) =
           sig_id <- genSignalId SigInternal ty
           -- Add a name hint to the signal
           addNameHint (Name.getOccString id) sig_id
-          addDef (UncondDef (Right $ Literal lit) sig_id)
+          addDef (UncondDef (Right $ Literal lit Nothing) sig_id)
           return ([], Single sig_id)
     IdInfo.VanillaGlobal ->
       -- Treat references to globals as an application with zero elements
@@ -218,9 +217,12 @@ flattenExpr binds app@(App _ _) = do
         sig_id <- genSignalId SigInternal ty
         -- TODO: fromInteger is defined for more types than just SizedWord
         let len = sized_word_len ty
-        -- TODO: to_stdlogicvector doesn't work here, since SizedWord
-        -- translates to a different type...
-        addDef (UncondDef (Right $ Literal $ "to_stdlogicvector(to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ "))") sig_id)
+        -- Use a to_unsigned to translate the number (a natural) to an unsiged
+        -- (array of bits)
+        let lit_str = "to_unsigned(" ++ (show int) ++ ", " ++ (show len) ++ ")"
+        -- Set the signal to our literal unconditionally, but add the type so
+        -- the literal will be typecast to the proper type.
+        addDef $ UncondDef (Right $ Literal lit_str (Just ty)) sig_id
         return ([], Single sig_id)
       else
         flattenApplicationExpr binds (CoreUtils.exprType app) f args
@@ -265,11 +267,12 @@ flattenExpr binds expr@(Case scrut b _ alts) = do
   -- TODO: Special casing for higher order functions
   -- Flatten the scrutinee
   (_, res) <- flattenExpr binds scrut
+  -- Put the scrutinee in the BindMap
+  let binds' = (b, Left res) : binds
   case alts of
-    -- TODO include b in the binds list
-    [alt] -> flattenSingleAltCaseExpr binds res b alt
+    [alt] -> flattenSingleAltCaseExpr binds' res b alt
     -- Reverse the alternatives, so the __DEFAULT alternative ends up last
-    otherwise -> flattenMultipleAltCaseExpr binds res b (reverse alts)
+    otherwise -> flattenMultipleAltCaseExpr binds' res b (reverse alts)
   where
     flattenSingleAltCaseExpr ::
       BindMap