1 module FlattenTypes where
3 import Data.Traversable
4 import qualified Data.Foldable as Foldable
5 import qualified Control.Monad.State as State
12 -- | A signal identifier
13 type UnnamedSignal = Int
15 -- | A map of a Haskell value to signal ids
16 type SignalMap sigid = HsValueMap sigid
18 -- | How is a given (single) value in a function's type (ie, argument or
19 -- return value) used?
21 Port -- ^ Use it as a port (input or output)
22 | State Int -- ^ Use it as state (input or output). The int is used to
23 -- match input state to output state.
24 | HighOrder { -- ^ Use it as a high order function input
25 hoName :: String, -- ^ Which function is passed in?
26 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
27 -- ^ map should only contain Port and other
30 deriving (Show, Eq, Ord)
32 -- | Is this HsValueUse a state use?
33 isStateUse :: HsValueUse -> Bool
34 isStateUse (State _) = True
37 -- | A map from a Haskell value to the use of each single value
38 type HsUseMap = HsValueMap HsValueUse
40 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
41 -- which all the Single elements are marked as State, with increasing state
43 useAsState :: HsValueMap a -> HsUseMap
47 -- Traverse the existing map, resulting in a function that maps an initial
48 -- state number to the final state number and the new map
49 PassState f = traverse asState map
50 -- Run this function to get the new map
52 -- This function maps each element to a State with a unique number, by
53 -- incrementing the state count.
54 asState x = PassState (\s -> (s+1, State s))
56 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
57 -- which all the Single elements are marked as Port.
58 useAsPort :: HsValueMap a -> HsUseMap
59 useAsPort map = fmap (\x -> Port) map
61 -- | A Haskell function with a specific signature. The signature defines what
62 -- use the arguments and return value of the function get.
63 data HsFunction = HsFunction {
65 hsFuncArgs :: [HsUseMap],
67 } deriving (Show, Eq, Ord)
69 hasState :: HsFunction -> Bool
71 any (Foldable.any isStateUse) (hsFuncArgs hsfunc)
72 || Foldable.any isStateUse (hsFuncRes hsfunc)
74 -- | A flattened function application
75 data FApp sigid = FApp {
76 appFunc :: HsFunction,
77 appArgs :: [SignalMap sigid],
78 appRes :: SignalMap sigid
81 -- | A conditional signal definition
82 data CondDef sigid = CondDef {
89 -- | How is a given signal used in the resulting VHDL?
91 SigPort -- | Use as a port
92 | SigInternal -- | Use as an internal signal
93 | SigState -- | Use as an internal state
94 | SigSubState -- | Do not use, state variable is used in a subcircuit
96 -- | Information on a signal definition
97 data SignalInfo = SignalInfo {
98 sigName :: Maybe String,
103 -- | A flattened function
104 data FlatFunction' sigid = FlatFunction {
105 flat_args :: [SignalMap sigid],
106 flat_res :: SignalMap sigid,
107 flat_apps :: [FApp sigid],
108 flat_conds :: [CondDef sigid],
109 flat_sigs :: [(sigid, SignalInfo)]
112 -- | A flat function that does not have its signals named
113 type FlatFunction = FlatFunction' UnnamedSignal
115 -- | A list of binds in effect at a particular point of evaluation
117 CoreBndr, -- ^ The bind name
118 Either -- ^ The bind value which is either
119 (SignalMap UnnamedSignal)
122 HsValueUse, -- ^ or a HighOrder function
123 [UnnamedSignal] -- ^ With these signals already applied to it
127 -- | The state during the flattening of a single function
128 type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [(UnnamedSignal, SignalInfo)], UnnamedSignal)
130 -- | Add an application to the current FlattenState
131 addApp :: (FApp UnnamedSignal) -> FlattenState ()
133 (apps, conds, sigs, n) <- State.get
134 State.put (a:apps, conds, sigs, n)
136 -- | Add a conditional definition to the current FlattenState
137 addCondDef :: (CondDef UnnamedSignal) -> FlattenState ()
139 (apps, conds, sigs, n) <- State.get
140 State.put (apps, c:conds, sigs, n)
142 -- | Generates a new signal id, which is unique within the current flattening.
143 genSignalId :: SigUse -> Type.Type -> FlattenState UnnamedSignal
144 genSignalId use ty = do
145 (apps, conds, sigs, n) <- State.get
146 -- Generate a new numbered but unnamed signal
147 let s = (n, SignalInfo Nothing use ty)
148 State.put (apps, conds, s:sigs, n+1)