1 module FlattenTypes where
4 import Data.Traversable
5 import qualified Data.Foldable as Foldable
6 import qualified Control.Monad.Trans.State as State
14 -- | A signal identifier
17 -- | A map of a Haskell value to signal ids
18 type SignalMap = HsValueMap SignalId
20 -- | A state identifier
23 -- | How is a given (single) value in a function's type (ie, argument or
24 -- return value) used?
26 Port -- ^ Use it as a port (input or output)
27 | State StateId -- ^ Use it as state (input or output). The int is used to
28 -- match input state to output state.
29 | HighOrder { -- ^ Use it as a high order function input
30 hoName :: String, -- ^ Which function is passed in?
31 hoArgs :: [HsUseMap] -- ^ Which arguments are already applied? This
32 -- ^ map should only contain Port and other
35 deriving (Show, Eq, Ord)
37 -- | Is this HsValueUse a state use?
38 isStateUse :: HsValueUse -> Bool
39 isStateUse (State _) = True
42 -- | A map from a Haskell value to the use of each single value
43 type HsUseMap = HsValueMap HsValueUse
45 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
46 -- which all the Single elements are marked as State, with increasing state
48 useAsState :: HsValueMap a -> HsUseMap
52 -- Traverse the existing map, resulting in a function that maps an initial
53 -- state number to the final state number and the new map
54 PassState f = traverse asState map
55 -- Run this function to get the new map
57 -- This function maps each element to a State with a unique number, by
58 -- incrementing the state count.
59 asState x = PassState (\s -> (s+1, State s))
61 -- | Builds a HsUseMap with the same structure has the given HsValueMap in
62 -- which all the Single elements are marked as Port.
63 useAsPort :: HsValueMap a -> HsUseMap
64 useAsPort map = fmap (\x -> Port) map
66 -- | A Haskell function with a specific signature. The signature defines what
67 -- use the arguments and return value of the function get.
68 data HsFunction = HsFunction {
70 hsFuncArgs :: [HsUseMap],
72 } deriving (Show, Eq, Ord)
74 hasState :: HsFunction -> Bool
76 any (Foldable.any isStateUse) (hsFuncArgs hsfunc)
77 || Foldable.any isStateUse (hsFuncRes hsfunc)
79 -- | Something that defines a signal
81 -- | A flattened function application
83 appFunc :: HsFunction,
84 appArgs :: [SignalMap],
87 -- | A conditional signal definition
94 -- | Unconditional signal definition
96 defSrc :: Either SignalId SignalExpr,
100 -- | Is the given SigDef a FApp?
101 is_FApp :: SigDef -> Bool
102 is_FApp d = case d of
106 -- | Which signals are used by the given SigDef?
107 sigDefUses :: SigDef -> [SignalId]
108 sigDefUses (UncondDef (Left id) _) = [id]
109 sigDefUses (UncondDef (Right expr) _) = sigExprUses expr
110 sigDefUses (CondDef cond true false _) = [cond, true, false]
111 sigDefUses (FApp _ args _) = concat $ map Foldable.toList args
113 -- | An expression on signals
115 EqLit SignalId String -- ^ Is the given signal equal to the given (VHDL) literal
116 | Literal String (Maybe Type.Type)-- ^ A literal value, with an optional type to cast to
117 | Eq SignalId SignalId -- ^ A comparison between to signals
120 -- Instantiate Eq for Type, so we can derive Eq for SignalExpr.
121 instance Eq Type.Type where
122 (==) = Type.coreEqType
124 -- | Which signals are used by the given SignalExpr?
125 sigExprUses :: SignalExpr -> [SignalId]
126 sigExprUses (EqLit id _) = [id]
127 sigExprUses (Literal _ _) = []
128 sigExprUses (Eq a b) = [a, b]
130 -- Returns the function used by the given SigDef, if any
131 usedHsFunc :: SigDef -> Maybe HsFunction
132 usedHsFunc (FApp hsfunc _ _) = Just hsfunc
133 usedHsFunc _ = Nothing
135 -- | How is a given signal used in the resulting VHDL?
137 SigPortIn -- | Use as an input port
138 | SigPortOut -- | Use as an input port
139 | SigInternal -- | Use as an internal signal
140 | SigStateOld StateId -- | Use as the current internal state
141 | SigStateNew StateId -- | Use as the new internal state
142 | SigSubState -- | Do not use, state variable is used in a subcircuit
145 -- | Is this a port signal use?
146 isPortSigUse :: SigUse -> Bool
147 isPortSigUse SigPortIn = True
148 isPortSigUse SigPortOut = True
149 isPortSigUse _ = False
151 -- | Is this a state signal use? Returns false for substate.
152 isStateSigUse :: SigUse -> Bool
153 isStateSigUse (SigStateOld _) = True
154 isStateSigUse (SigStateNew _) = True
155 isStateSigUse _ = False
157 -- | Is this an internal signal use?
158 isInternalSigUse :: SigUse -> Bool
159 isInternalSigUse SigInternal = True
160 isInternalSigUse _ = False
162 oldStateId :: SigUse -> Maybe StateId
163 oldStateId (SigStateOld id) = Just id
164 oldStateId _ = Nothing
166 newStateId :: SigUse -> Maybe StateId
167 newStateId (SigStateNew id) = Just id
168 newStateId _ = Nothing
170 -- | Information on a signal definition
171 data SignalInfo = SignalInfo {
172 sigName :: Maybe String,
175 nameHints :: [String]
178 -- | A flattened function
179 data FlatFunction = FlatFunction {
180 flat_args :: [SignalMap],
181 flat_res :: SignalMap,
182 flat_defs :: [SigDef],
183 flat_sigs :: [(SignalId, SignalInfo)]
186 -- | Lookup a given signal id in a signal map, and return the associated
187 -- SignalInfo. Errors out if the signal was not found.
188 signalInfo :: [(SignalId, SignalInfo)] -> SignalId -> SignalInfo
189 signalInfo sigs id = Maybe.fromJust $ lookup id sigs
191 -- | A list of binds in effect at a particular point of evaluation
193 CoreBndr, -- ^ The bind name
194 BindValue -- ^ The value bound to it
198 Either -- ^ The bind value which is either
202 HsValueUse, -- ^ or a HighOrder function
203 [SignalId] -- ^ With these signals already applied to it
206 -- | The state during the flattening of a single function
207 type FlattenState = State.State ([SigDef], [(SignalId, SignalInfo)], SignalId)
209 -- | Add an application to the current FlattenState
210 addDef :: SigDef -> FlattenState ()
212 (defs, sigs, n) <- State.get
213 State.put (d:defs, sigs, n)
215 -- | Generates a new signal id, which is unique within the current flattening.
216 genSignalId :: SigUse -> Type.Type -> FlattenState SignalId
217 genSignalId use ty = do
218 (defs, sigs, n) <- State.get
219 -- Generate a new numbered but unnamed signal
220 let s = (n, SignalInfo Nothing use ty [])
221 State.put (defs, s:sigs, n+1)
224 -- | Add a name hint to the given signal
225 addNameHint :: String -> SignalId -> FlattenState ()
226 addNameHint hint id = do
227 info <- getSignalInfo id
228 let hints = nameHints info
233 let hints' = (hint:hints)
234 setSignalInfo id (info {nameHints = hints'})
236 -- | Returns the SignalInfo for the given signal. Errors if the signal is not
237 -- known in the session.
238 getSignalInfo :: SignalId -> FlattenState SignalInfo
239 getSignalInfo id = do
240 (defs, sigs, n) <- State.get
241 return $ signalInfo sigs id
243 setSignalInfo :: SignalId -> SignalInfo -> FlattenState ()
244 setSignalInfo id' info' = do
245 (defs, sigs, n) <- State.get
246 let sigs' = map (\(id, info) -> (id, if id == id' then info' else info)) sigs
247 State.put (defs, sigs', n)
249 -- vim: set ts=8 sw=2 sts=2 expandtab: