Add accessor methods for FlattenState.

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

diff --git a/Flatten.hs b/Flatten.hs
index a6b3be8f294eaed3ed07320975161c15d4fa91c1..ee70446eaf5ed1b39ff56630b107a49f07fd1077 100644 (file)
--- a/Flatten.hs
+++ b/Flatten.hs
@@ -1,6 +1,15 @@
 module Flatten where
-import Translator (HsValueMap)
+import CoreSyn
+import qualified Control.Monad.State as State
 
+-- | A datatype that maps each of the single values in a haskell structure to
+-- a mapto. The map has the same structure as the haskell type mapped, ie
+-- nested tuples etc.
+data HsValueMap mapto =
+  Tuple [HsValueMap mapto]
+  | Single mapto
+  | Unused
+  deriving (Show, Eq)
 
 data FlatFunction = FlatFunction {
   args   :: [SignalDefMap],
@@ -13,12 +22,13 @@ data FlatFunction = FlatFunction {
 type SignalUseMap = HsValueMap SignalUse
 type SignalDefMap = HsValueMap SignalDef
 
+type SignalId = Int
 data SignalUse = SignalUse {
-  sigUseId :: Int
+  sigUseId :: SignalId
 } deriving (Show, Eq)
 
 data SignalDef = SignalDef {
-  sigDefId :: Int
+  sigDefId :: SignalId
 } deriving (Show, Eq)
 
 data App = App {
@@ -65,4 +75,51 @@ type BindMap = [(
       [SignalUse]      -- ^ With these signals already applied to it
     )
   )]
+
+type FlattenState = State.State ([App], [CondDef], SignalId)
+
+-- | Add an application to the current FlattenState
+addApp :: App -> FlattenState ()
+addApp a = do
+  (apps, conds, n) <- State.get
+  State.put (a:apps, conds, n)
+
+-- | Add a conditional definition to the current FlattenState
+addCondDef :: CondDef -> FlattenState ()
+addCondDef c = do
+  (apps, conds, n) <- State.get
+  State.put (apps, c:conds, n)
+
+-- | Generates a new signal id, which is unique within the current flattening.
+genSignalId :: FlattenState SignalId 
+genSignalId = do
+  (apps, conds, n) <- State.get
+  State.put (apps, conds, n+1)
+  return n
+
+-- | Flatten a haskell function
+flattenFunction ::
+  HsFunction                      -- ^ The function to flatten
+  -> CoreBind                     -- ^ The function value
+  -> FlatFunction                 -- ^ The resulting flat function
+
+flattenFunction _ (Rec _) = error "Recursive binders not supported"
+flattenFunction hsfunc bind@(NonRec var expr) =
+  FlatFunction args res apps conds
+  where
+    init_state        = ([], [], 0)
+    (fres, end_state) = State.runState (flattenExpr expr) init_state
+    (args, res)       = fres
+    (apps, conds, _)  = end_state
+
+flattenExpr ::
+  CoreExpr
+  -> FlattenState ([SignalDefMap], SignalUseMap)
+
+flattenExpr _ = do
+  return ([], Tuple [])
+
+
+
+
 -- vim: set ts=8 sw=2 sts=2 expandtab: