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 -- | Information on a signal definition
78 data Signal sigid = Signal {
82 -- | A flattened function
83 data FlatFunction' sigid = FlatFunction {
84 args :: [SignalMap sigid],
85 res :: SignalMap sigid,
87 conds :: [CondDef sigid],
88 sigs :: [Signal sigid]
91 -- | A flat function that does not have its signals named
92 type FlatFunction = FlatFunction' UnnamedSignal
94 -- | A list of binds in effect at a particular point of evaluation
96 CoreBndr, -- ^ The bind name
97 Either -- ^ The bind value which is either
98 (SignalMap UnnamedSignal)
101 HsValueUse, -- ^ or a HighOrder function
102 [UnnamedSignal] -- ^ With these signals already applied to it
106 -- | The state during the flattening of a single function
107 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], UnnamedSignal)
109 -- | Add an application to the current FlattenState
110 addApp :: (FApp UnnamedSignal) -> FlattenState ()
112 (apps, conds, n) <- State.get
113 State.put (a:apps, conds, n)
115 -- | Add a conditional definition to the current FlattenState
116 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
118 (apps, conds, n) <- State.get
119 State.put (apps, c:conds, n)
121 -- | Generates a new signal id, which is unique within the current flattening.
122 genSignalId :: FlattenState UnnamedSignal
124 (apps, conds, n) <- State.get
125 State.put (apps, conds, n+1)