1 module FlattenTypes where
3 import Data.Traversable
4 import qualified Control.Monad.State as State
11 -- | A signal identifier
12 type UnnamedSignal = Int
14 -- | A map of a Haskell value to signal ids
15 type SignalMap sigid = HsValueMap sigid
17 -- | How is a given (single) value in a function's type (ie, argument or
18 -- return value) used?
20 Port -- ^ Use it as a port (input or output)
21 | State Int -- ^ Use it as state (input or output). The int is used to
22 -- match input state to output state.
23 | HighOrder { -- ^ Use it as a high order function input
24 hoName :: String, -- ^ Which function is passed in?
25 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
26 -- ^ map should only contain Port and other
29 deriving (Show, Eq, Ord)
31 -- | A map from a Haskell value to the use of each single value
32 type HsUseMap = HsValueMap HsValueUse
34 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
35 -- which all the Single elements are marked as State, with increasing state
37 useAsState :: HsValueMap a -> HsUseMap
41 -- Traverse the existing map, resulting in a function that maps an initial
42 -- state number to the final state number and the new map
43 PassState f = traverse asState map
44 -- Run this function to get the new map
46 -- This function maps each element to a State with a unique number, by
47 -- incrementing the state count.
48 asState x = PassState (\s -> (s+1, State s))
50 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
51 -- which all the Single elements are marked as Port.
52 useAsPort :: HsValueMap a -> HsUseMap
53 useAsPort map = fmap (\x -> Port) map
55 -- | A Haskell function with a specific signature. The signature defines what
56 -- use the arguments and return value of the function get.
57 data HsFunction = HsFunction {
59 hsFuncArgs :: [HsUseMap],
61 } deriving (Show, Eq, Ord)
63 -- | A flattened function application
64 data FApp sigid = FApp {
65 appFunc :: HsFunction,
66 appArgs :: [SignalMap sigid],
67 appRes :: SignalMap sigid
70 -- | A conditional signal definition
71 data CondDef sigid = CondDef {
78 -- | Information on a signal definition
79 data SignalInfo = SignalInfo {
80 sigName :: Maybe String,
84 -- | A flattened function
85 data FlatFunction' sigid = FlatFunction {
86 flat_args :: [SignalMap sigid],
87 flat_res :: SignalMap sigid,
88 flat_apps :: [FApp sigid],
89 flat_conds :: [CondDef sigid],
90 flat_sigs :: [(sigid, SignalInfo)]
93 -- | A flat function that does not have its signals named
94 type FlatFunction = FlatFunction' UnnamedSignal
96 -- | A list of binds in effect at a particular point of evaluation
98 CoreBndr, -- ^ The bind name
99 Either -- ^ The bind value which is either
100 (SignalMap UnnamedSignal)
103 HsValueUse, -- ^ or a HighOrder function
104 [UnnamedSignal] -- ^ With these signals already applied to it
108 -- | The state during the flattening of a single function
109 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [(UnnamedSignal, SignalInfo)], UnnamedSignal)
111 -- | Add an application to the current FlattenState
112 addApp :: (FApp UnnamedSignal) -> FlattenState ()
114 (apps, conds, sigs, n) <- State.get
115 State.put (a:apps, conds, sigs, n)
117 -- | Add a conditional definition to the current FlattenState
118 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
120 (apps, conds, sigs, n) <- State.get
121 State.put (apps, c:conds, sigs, n)
123 -- | Generates a new signal id, which is unique within the current flattening.
124 genSignalId :: Type.Type -> FlattenState UnnamedSignal
126 (apps, conds, sigs, n) <- State.get
127 -- Generate a new numbered but unnamed signal
128 let s = (n, SignalInfo Nothing ty)
129 State.put (apps, conds, s:sigs, n+1)