Make flattenExpr return signal definitions for arguments.

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

diff --git a/Flatten.hs b/Flatten.hs
index f3057e86399a1a2d895730719dc9954b87d17e87..598c8c6050df46cba753bb97351aff4abf4c559a 100644 (file)
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -1,7 +1,9 @@
 module Flatten where
 import CoreSyn
 import qualified Type
+import qualified Name
 import qualified TyCon
+import qualified Maybe
 import qualified CoreUtils
 import qualified Control.Monad.State as State
 
@@ -42,6 +44,10 @@ data FlatFunction = FlatFunction {
 type SignalUseMap = HsValueMap SignalUse
 type SignalDefMap = HsValueMap SignalDef
 
+useMapToDefMap :: SignalUseMap -> SignalDefMap
+useMapToDefMap (Single (SignalUse u)) = Single (SignalDef u)
+useMapToDefMap (Tuple uses) = Tuple (map useMapToDefMap uses)
+
 type SignalId = Int
 data SignalUse = SignalUse {
   sigUseId :: SignalId
@@ -165,7 +171,17 @@ flattenExpr binds lam@(Lam b expr) = do
   -- Create signal names for the binder
   defs <- genSignalUses arg_ty
   let binds' = (b, Left defs):binds
-  flattenExpr binds' expr
+  (args, res) <- flattenExpr binds' expr
+  return ((useMapToDefMap defs) : args, res)
+
+flattenExpr binds (Var id) =
+  case bind of
+    Left sig_use -> return ([], sig_use)
+    Right _ -> error "Higher order functions not supported."
+  where
+    bind = Maybe.fromMaybe
+      (error $ "Argument " ++ Name.getOccString id ++ "is unknown")
+      (lookup id binds)
 
 flattenExpr _ _ = do
   return ([], Tuple [])