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 use of a signal
14 data SignalUse sigid = SignalUse {
18 -- | A def of a signal
19 data SignalDef sigid = SignalDef {
23 -- | A map of a Haskell value to signal uses
24 type SignalUseMap sigid = HsValueMap (SignalUse sigid)
25 -- | A map of a Haskell value to signal defs
26 type SignalDefMap sigid = HsValueMap (SignalDef sigid)
28 -- | Translate a SignalUseMap to an equivalent SignalDefMap
29 useMapToDefMap :: SignalUseMap sigid -> SignalDefMap sigid
30 useMapToDefMap = fmap (\(SignalUse u) -> SignalDef u)
32 -- | Translate a SignalDefMap to an equivalent SignalUseMap
33 defMapToUseMap :: SignalDefMap sigid -> SignalUseMap sigid
34 defMapToUseMap = fmap (\(SignalDef u) -> SignalUse u)
36 -- | How is a given (single) value in a function's type (ie, argument or
37 -- return value) used?
39 Port -- ^ Use it as a port (input or output)
40 | State Int -- ^ Use it as state (input or output). The int is used to
41 -- match input state to output state.
42 | HighOrder { -- ^ Use it as a high order function input
43 hoName :: String, -- ^ Which function is passed in?
44 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
45 -- ^ map should only contain Port and other
48 deriving (Show, Eq, Ord)
50 -- | A map from a Haskell value to the use of each single value
51 type HsUseMap = HsValueMap HsValueUse
53 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
54 -- which all the Single elements are marked as State, with increasing state
56 useAsState :: HsValueMap a -> HsUseMap
60 -- Traverse the existing map, resulting in a function that maps an initial
61 -- state number to the final state number and the new map
62 PassState f = traverse asState map
63 -- Run this function to get the new map
65 -- This function maps each element to a State with a unique number, by
66 -- incrementing the state count.
67 asState x = PassState (\s -> (s+1, State s))
69 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
70 -- which all the Single elements are marked as Port.
71 useAsPort :: HsValueMap a -> HsUseMap
72 useAsPort map = fmap (\x -> Port) map
74 -- | A Haskell function with a specific signature. The signature defines what
75 -- use the arguments and return value of the function get.
76 data HsFunction = HsFunction {
78 hsFuncArgs :: [HsUseMap],
80 } deriving (Show, Eq, Ord)
82 -- | A flattened function application
83 data FApp sigid = FApp {
84 appFunc :: HsFunction,
85 appArgs :: [SignalUseMap sigid],
86 appRes :: SignalDefMap sigid
89 -- | A conditional signal definition
90 data CondDef sigid = CondDef {
91 cond :: SignalUse sigid,
92 high :: SignalUse sigid,
93 low :: SignalUse sigid,
94 condRes :: SignalDef sigid
97 -- | A flattened function
98 data FlatFunction' sigid = FlatFunction {
99 args :: [SignalDefMap sigid],
100 res :: SignalUseMap sigid,
101 --sigs :: [SignalDef],
102 apps :: [FApp sigid],
103 conds :: [CondDef sigid]
104 } deriving (Show, Eq)
106 -- | A flat function that does not have its signals named
107 type FlatFunction = FlatFunction' UnnamedSignal
109 -- | A list of binds in effect at a particular point of evaluation
111 CoreBndr, -- ^ The bind name
112 Either -- ^ The bind value which is either
113 (SignalUseMap UnnamedSignal)
116 HsValueUse, -- ^ or a HighOrder function
117 [SignalUse UnnamedSignal] -- ^ With these signals already applied to it
121 -- | The state during the flattening of a single function
122 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], UnnamedSignal)
124 -- | Add an application to the current FlattenState
125 addApp :: (FApp UnnamedSignal) -> FlattenState ()
127 (apps, conds, n) <- State.get
128 State.put (a:apps, conds, n)
130 -- | Add a conditional definition to the current FlattenState
131 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
133 (apps, conds, n) <- State.get
134 State.put (apps, c:conds, n)
136 -- | Generates a new signal id, which is unique within the current flattening.
137 genSignalId :: FlattenState UnnamedSignal
139 (apps, conds, n) <- State.get
140 State.put (apps, conds, n+1)