1 module FlattenTypes where
3 import Data.Traversable
4 import qualified Control.Monad.State as State
10 -- | A signal identifier
11 type UnnamedSignal = Int
13 -- | A map of a Haskell value to signal ids
14 type SignalMap sigid = HsValueMap sigid
16 -- | How is a given (single) value in a function's type (ie, argument or
17 -- return value) used?
19 Port -- ^ Use it as a port (input or output)
20 | State Int -- ^ Use it as state (input or output). The int is used to
21 -- match input state to output state.
22 | HighOrder { -- ^ Use it as a high order function input
23 hoName :: String, -- ^ Which function is passed in?
24 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
25 -- ^ map should only contain Port and other
28 deriving (Show, Eq, Ord)
30 -- | A map from a Haskell value to the use of each single value
31 type HsUseMap = HsValueMap HsValueUse
33 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
34 -- which all the Single elements are marked as State, with increasing state
36 useAsState :: HsValueMap a -> HsUseMap
40 -- Traverse the existing map, resulting in a function that maps an initial
41 -- state number to the final state number and the new map
42 PassState f = traverse asState map
43 -- Run this function to get the new map
45 -- This function maps each element to a State with a unique number, by
46 -- incrementing the state count.
47 asState x = PassState (\s -> (s+1, State s))
49 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
50 -- which all the Single elements are marked as Port.
51 useAsPort :: HsValueMap a -> HsUseMap
52 useAsPort map = fmap (\x -> Port) map
54 -- | A Haskell function with a specific signature. The signature defines what
55 -- use the arguments and return value of the function get.
56 data HsFunction = HsFunction {
58 hsFuncArgs :: [HsUseMap],
60 } deriving (Show, Eq, Ord)
62 -- | A flattened function application
63 data FApp sigid = FApp {
64 appFunc :: HsFunction,
65 appArgs :: [SignalMap sigid],
66 appRes :: SignalMap sigid
69 -- | A conditional signal definition
70 data CondDef sigid = CondDef {
77 -- | A flattened function
78 data FlatFunction' sigid = FlatFunction {
79 args :: [SignalMap sigid],
80 res :: SignalMap sigid,
83 conds :: [CondDef sigid]
86 -- | A flat function that does not have its signals named
87 type FlatFunction = FlatFunction' UnnamedSignal
89 -- | A list of binds in effect at a particular point of evaluation
91 CoreBndr, -- ^ The bind name
92 Either -- ^ The bind value which is either
93 (SignalMap UnnamedSignal)
96 HsValueUse, -- ^ or a HighOrder function
97 [UnnamedSignal] -- ^ With these signals already applied to it
101 -- | The state during the flattening of a single function
102 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], UnnamedSignal)
104 -- | Add an application to the current FlattenState
105 addApp :: (FApp UnnamedSignal) -> FlattenState ()
107 (apps, conds, n) <- State.get
108 State.put (a:apps, conds, n)
110 -- | Add a conditional definition to the current FlattenState
111 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
113 (apps, conds, n) <- State.get
114 State.put (apps, c:conds, n)
116 -- | Generates a new signal id, which is unique within the current flattening.
117 genSignalId :: FlattenState UnnamedSignal
119 (apps, conds, n) <- State.get
120 State.put (apps, conds, n+1)