type StateId = Int
-- | How is a given (single) value in a function's type (ie, argument or
--- return value) used?
+-- return value) used?
data HsValueUse =
Port -- ^ Use it as a port (input or output)
| State StateId -- ^ Use it as state (input or output). The int is used to
}
-- | Unconditional signal definition
| UncondDef {
- defSrc :: SignalId,
+ defSrc :: Either SignalId SignalExpr,
defDst :: SignalId
} deriving (Show, Eq)
+-- | Is the given SigDef a FApp?
+is_FApp :: SigDef -> Bool
+is_FApp d = case d of
+ (FApp _ _ _) -> True
+ _ -> False
+
+-- | Which signals are used by the given SigDef?
+sigDefUses :: SigDef -> [SignalId]
+sigDefUses (UncondDef (Left id) _) = [id]
+sigDefUses (UncondDef (Right expr) _) = sigExprUses expr
+sigDefUses (CondDef cond true false _) = [cond, true, false]
+sigDefUses (FApp _ args _) = concat $ map Foldable.toList args
+
+-- | An expression on signals
+data SignalExpr =
+ EqLit SignalId String -- ^ Is the given signal equal to the given (VHDL) literal
+ | Literal String -- ^ A literal value
+ | Eq SignalId SignalId -- ^ A comparison between to signals
+ deriving (Show, Eq)
+
+-- | Which signals are used by the given SignalExpr?
+sigExprUses :: SignalExpr -> [SignalId]
+sigExprUses (EqLit id _) = [id]
+sigExprUses (Literal _) = []
+sigExprUses (Eq a b) = [a, b]
+
-- Returns the function used by the given SigDef, if any
usedHsFunc :: SigDef -> Maybe HsFunction
usedHsFunc (FApp hsfunc _ _) = Just hsfunc
isInternalSigUse SigInternal = True
isInternalSigUse _ = False
+oldStateId :: SigUse -> Maybe StateId
+oldStateId (SigStateOld id) = Just id
+oldStateId _ = Nothing
+
+newStateId :: SigUse -> Maybe StateId
+newStateId (SigStateNew id) = Just id
+newStateId _ = Nothing
+
-- | Information on a signal definition
data SignalInfo = SignalInfo {
sigName :: Maybe String,
sigUse :: SigUse,
- sigTy :: Type.Type
+ sigTy :: Type.Type,
+ nameHints :: [String]
}
-- | A flattened function
-- | A list of binds in effect at a particular point of evaluation
type BindMap = [(
CoreBndr, -- ^ The bind name
+ BindValue -- ^ The value bound to it
+ )]
+
+type BindValue =
Either -- ^ The bind value which is either
(SignalMap)
-- ^ a signal
HsValueUse, -- ^ or a HighOrder function
[SignalId] -- ^ With these signals already applied to it
)
- )]
-- | The state during the flattening of a single function
type FlattenState = State.State ([SigDef], [(SignalId, SignalInfo)], SignalId)
genSignalId use ty = do
(defs, sigs, n) <- State.get
-- Generate a new numbered but unnamed signal
- let s = (n, SignalInfo Nothing use ty)
+ let s = (n, SignalInfo Nothing use ty [])
State.put (defs, s:sigs, n+1)
return n
+
+-- | Add a name hint to the given signal
+addNameHint :: String -> SignalId -> FlattenState ()
+addNameHint hint id = do
+ info <- getSignalInfo id
+ let hints = nameHints info
+ if hint `elem` hints
+ then do
+ return ()
+ else do
+ let hints' = (hint:hints)
+ setSignalInfo id (info {nameHints = hints'})
+
+-- | Returns the SignalInfo for the given signal. Errors if the signal is not
+-- known in the session.
+getSignalInfo :: SignalId -> FlattenState SignalInfo
+getSignalInfo id = do
+ (defs, sigs, n) <- State.get
+ return $ signalInfo sigs id
+
+setSignalInfo :: SignalId -> SignalInfo -> FlattenState ()
+setSignalInfo id' info' = do
+ (defs, sigs, n) <- State.get
+ let sigs' = map (\(id, info) -> (id, if id == id' then info' else info)) sigs
+ State.put (defs, sigs', n)
+
+-- vim: set ts=8 sw=2 sts=2 expandtab: