3 import qualified Control.Monad.State as State
5 -- | A datatype that maps each of the single values in a haskell structure to
6 -- a mapto. The map has the same structure as the haskell type mapped, ie
8 data HsValueMap mapto =
9 Tuple [HsValueMap mapto]
14 data FlatFunction = FlatFunction {
15 args :: [SignalDefMap],
17 --sigs :: [SignalDef],
22 type SignalUseMap = HsValueMap SignalUse
23 type SignalDefMap = HsValueMap SignalDef
26 data SignalUse = SignalUse {
30 data SignalDef = SignalDef {
35 appFunc :: HsFunction,
36 appArgs :: [SignalUseMap],
37 appRes :: SignalDefMap
40 data CondDef = CondDef {
47 -- | How is a given (single) value in a function's type (ie, argument or
48 -- return value) used?
50 Port -- ^ Use it as a port (input or output)
51 | State Int -- ^ Use it as state (input or output). The int is used to
52 -- match input state to output state.
53 | HighOrder { -- ^ Use it as a high order function input
54 hoName :: String, -- ^ Which function is passed in?
55 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
56 -- ^ map should only contain Port and other
61 type HsUseMap = HsValueMap HsValueUse
63 data HsFunction = HsFunction {
65 hsFuncArgs :: [HsUseMap],
70 String, -- ^ The bind name
71 Either -- ^ The bind value which is either
72 SignalUse -- ^ a signal
74 HsValueUse, -- ^ or a HighOrder function
75 [SignalUse] -- ^ With these signals already applied to it
79 type FlattenState = State.State ([App], [CondDef], SignalId)
81 -- | Add an application to the current FlattenState
82 addApp :: App -> FlattenState ()
84 (apps, conds, n) <- State.get
85 State.put (a:apps, conds, n)
87 -- | Add a conditional definition to the current FlattenState
88 addCondDef :: CondDef -> FlattenState ()
90 (apps, conds, n) <- State.get
91 State.put (apps, c:conds, n)
93 -- | Generates a new signal id, which is unique within the current flattening.
94 genSignalId :: FlattenState SignalId
96 (apps, conds, n) <- State.get
97 State.put (apps, conds, n+1)
100 -- | Flatten a haskell function
102 HsFunction -- ^ The function to flatten
103 -> CoreBind -- ^ The function value
104 -> FlatFunction -- ^ The resulting flat function
106 flattenFunction _ (Rec _) = error "Recursive binders not supported"
107 flattenFunction hsfunc bind@(NonRec var expr) =
108 FlatFunction args res apps conds
110 init_state = ([], [], 0)
111 (fres, end_state) = State.runState (flattenExpr expr) init_state
113 (apps, conds, _) = end_state
117 -> FlattenState ([SignalDefMap], SignalUseMap)
120 return ([], Tuple [])
125 -- vim: set ts=8 sw=2 sts=2 expandtab: