X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=FlattenTypes.hs;h=d0076636bdcd07e266215b74e92e875e4f547e17;hb=ee2454dbeb8d41d615726593acd8600c4a3253ae;hp=8dbdc3b6ab2b9b1a676cd554ba72a78d96e52b38;hpb=2ab93a2a97e22ca0bd57a2738fd0a48104fffbe5;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 8dbdc3b..d007663 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -92,10 +92,17 @@ data SigDef = } -- | Unconditional signal definition | UncondDef { - defSrc :: SignalId, + defSrc :: Either SignalId SignalExpr, defDst :: SignalId } deriving (Show, Eq) +-- | 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) + -- Returns the function used by the given SigDef, if any usedHsFunc :: SigDef -> Maybe HsFunction usedHsFunc (FApp hsfunc _ _) = Just hsfunc @@ -131,7 +138,8 @@ isInternalSigUse _ = False data SignalInfo = SignalInfo { sigName :: Maybe String, sigUse :: SigUse, - sigTy :: Type.Type + sigTy :: Type.Type, + nameHints :: [String] } -- | A flattened function @@ -150,6 +158,10 @@ signalInfo sigs id = Maybe.fromJust $ lookup id sigs -- | 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 @@ -157,7 +169,6 @@ type BindMap = [( 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) @@ -173,10 +184,18 @@ genSignalId :: SigUse -> Type.Type -> FlattenState 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 :: SignalId -> String -> FlattenState () +addNameHint id hint = do + info <- getSignalInfo id + let hints = nameHints info + 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