From: Matthijs Kooijman Date: Tue, 17 Feb 2009 16:47:43 +0000 (+0100) Subject: Remove type parameterisation of SignalMap. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=e273d2759db01787f0599a1cbe9059864e1704d7;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Remove type parameterisation of SignalMap. --- diff --git a/Flatten.hs b/Flatten.hs index 115460c..4194904 100644 --- a/Flatten.hs +++ b/Flatten.hs @@ -28,7 +28,7 @@ dataConAppArgs dc args = genSignals :: Type.Type - -> FlattenState (SignalMap UnnamedSignal) + -> FlattenState SignalMap genSignals ty = -- First generate a map with the right structure containing the types, and @@ -37,13 +37,13 @@ genSignals ty = -- | Marks a signal as the given SigUse, if its id is in the list of id's -- given. -markSignals :: SigUse -> [UnnamedSignal] -> (UnnamedSignal, SignalInfo) -> (UnnamedSignal, SignalInfo) +markSignals :: SigUse -> [SignalId] -> (SignalId, SignalInfo) -> (SignalId, SignalInfo) markSignals use ids (id, info) = (id, info') where info' = if id `elem` ids then info { sigUse = use} else info -markSignal :: SigUse -> UnnamedSignal -> (UnnamedSignal, SignalInfo) -> (UnnamedSignal, SignalInfo) +markSignal :: SigUse -> SignalId -> (SignalId, SignalInfo) -> (SignalId, SignalInfo) markSignal use id = markSignals use [id] -- | Flatten a haskell function @@ -74,7 +74,7 @@ flattenFunction hsfunc bind@(NonRec var expr) = flattenExpr :: BindMap -> CoreExpr - -> FlattenState ([SignalMap UnnamedSignal], (SignalMap UnnamedSignal)) + -> FlattenState ([SignalMap], SignalMap) flattenExpr binds lam@(Lam b expr) = do -- Find the type of the binder @@ -165,7 +165,7 @@ flattenExpr binds expr@(Case (Var v) b _ alts) = -> Var.Var -- The scrutinee -> CoreBndr -- The binder to bind the scrutinee to -> CoreAlt -- The single alternative - -> FlattenState ( [SignalMap UnnamedSignal], SignalMap UnnamedSignal) + -> FlattenState ( [SignalMap], SignalMap) -- See expandExpr flattenSingleAltCaseExpr binds v b alt@(DataAlt datacon, bind_vars, expr) = if not (DataCon.isTupleCon datacon) @@ -208,9 +208,9 @@ appToHsFunction ty f args = -- | Filters non-state signals and returns the state number and signal id for -- state values. filterState :: - UnnamedSignal -- | The signal id to look at + SignalId -- | The signal id to look at -> HsValueUse -- | How is this signal used? - -> Maybe (Int, UnnamedSignal ) -- | The state num and signal id, if this + -> Maybe (Int, SignalId ) -- | The state num and signal id, if this -- signal was used as state filterState id (State num) = @@ -221,8 +221,8 @@ filterState _ _ = Nothing -- signals in the given maps. stateList :: HsUseMap - -> (SignalMap UnnamedSignal) - -> [(Int, UnnamedSignal)] + -> (SignalMap) + -> [(Int, SignalId)] stateList uses signals = Maybe.catMaybes $ Foldable.toList $ zipValueMapsWith filterState signals uses diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 9f080f7..fc77816 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -11,10 +11,10 @@ import qualified Type import HsValueMap -- | A signal identifier -type UnnamedSignal = Int +type SignalId = Int -- | A map of a Haskell value to signal ids -type SignalMap sigid = HsValueMap sigid +type SignalMap = HsValueMap SignalId -- | How is a given (single) value in a function's type (ie, argument or -- return value) used? @@ -73,18 +73,18 @@ hasState hsfunc = || Foldable.any isStateUse (hsFuncRes hsfunc) -- | A flattened function application -data FApp sigid = FApp { +data FApp = FApp { appFunc :: HsFunction, - appArgs :: [SignalMap sigid], - appRes :: SignalMap sigid + appArgs :: [SignalMap], + appRes :: SignalMap } deriving (Show, Eq) -- | A conditional signal definition -data CondDef sigid = CondDef { - cond :: sigid, - high :: sigid, - low :: sigid, - condRes :: sigid +data CondDef = CondDef { + cond :: SignalId, + high :: SignalId, + low :: SignalId, + condRes :: SignalId } deriving (Show, Eq) -- | How is a given signal used in the resulting VHDL? @@ -121,51 +121,48 @@ data SignalInfo = SignalInfo { } -- | A flattened function -data FlatFunction' sigid = FlatFunction { - flat_args :: [SignalMap sigid], - flat_res :: SignalMap sigid, - flat_apps :: [FApp sigid], - flat_conds :: [CondDef sigid], - flat_sigs :: [(sigid, SignalInfo)] +data FlatFunction = FlatFunction { + flat_args :: [SignalMap], + flat_res :: SignalMap, + flat_apps :: [FApp], + flat_conds :: [CondDef], + flat_sigs :: [(SignalId, SignalInfo)] } -- | Lookup a given signal id in a signal map, and return the associated -- SignalInfo. Errors out if the signal was not found. -signalInfo :: Eq sigid => [(sigid, SignalInfo)] -> sigid -> SignalInfo +signalInfo :: [(SignalId, SignalInfo)] -> SignalId -> SignalInfo signalInfo sigs id = Maybe.fromJust $ lookup id sigs --- | A flat function that does not have its signals named -type FlatFunction = FlatFunction' UnnamedSignal - -- | A list of binds in effect at a particular point of evaluation type BindMap = [( CoreBndr, -- ^ The bind name Either -- ^ The bind value which is either - (SignalMap UnnamedSignal) + (SignalMap) -- ^ a signal ( HsValueUse, -- ^ or a HighOrder function - [UnnamedSignal] -- ^ With these signals already applied to it + [SignalId] -- ^ With these signals already applied to it ) )] -- | The state during the flattening of a single function -type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [(UnnamedSignal, SignalInfo)], UnnamedSignal) +type FlattenState = State.State ([FApp], [CondDef], [(SignalId, SignalInfo)], SignalId) -- | Add an application to the current FlattenState -addApp :: (FApp UnnamedSignal) -> FlattenState () +addApp :: (FApp) -> FlattenState () addApp a = do (apps, conds, sigs, n) <- State.get State.put (a:apps, conds, sigs, n) -- | Add a conditional definition to the current FlattenState -addCondDef :: (CondDef UnnamedSignal) -> FlattenState () +addCondDef :: (CondDef) -> FlattenState () addCondDef c = do (apps, conds, sigs, n) <- State.get State.put (apps, c:conds, sigs, n) -- | Generates a new signal id, which is unique within the current flattening. -genSignalId :: SigUse -> Type.Type -> FlattenState UnnamedSignal +genSignalId :: SigUse -> Type.Type -> FlattenState SignalId genSignalId use ty = do (apps, conds, sigs, n) <- State.get -- Generate a new numbered but unnamed signal diff --git a/Pretty.hs b/Pretty.hs index 7c98404..ba0e3d0 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -36,7 +36,7 @@ instance Pretty HsValueUse where pPrint (State n) = char 'C' <> int n pPrint (HighOrder _ _) = text "Higher Order" -instance Pretty id => Pretty (FlatFunction' id) where +instance Pretty FlatFunction where pPrint (FlatFunction args res apps conds sigs) = (text "Args: ") $$ nest 10 (pPrint args) $+$ (text "Result: ") $$ nest 10 (pPrint res) @@ -46,11 +46,11 @@ instance Pretty id => Pretty (FlatFunction' id) where where ppsig (id, info) = pPrint id <> pPrint info -instance Pretty id => Pretty (FApp id) where +instance Pretty FApp where pPrint (FApp func args res) = pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res -instance Pretty id => Pretty (CondDef id) where +instance Pretty CondDef where pPrint _ = text "TODO" instance Pretty SignalInfo where diff --git a/VHDL.hs b/VHDL.hs index 9516fdd..32279fd 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -176,8 +176,8 @@ getSignalId info = -- | Transforms a flat function application to a VHDL component instantiation. mkCompInsSm :: - [(UnnamedSignal, SignalInfo)] -- | The signals in the current architecture - -> FApp UnnamedSignal -- | The application to look at. + [(SignalId, SignalInfo)] -- | The signals in the current architecture + -> FApp -- | The application to look at. -> VHDLState AST.CompInsSm -- | The corresponding VHDL component instantiation. mkCompInsSm sigs app = do @@ -195,8 +195,8 @@ mkCompInsSm sigs app = do return $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps) mkAssocElems :: - [(UnnamedSignal, SignalInfo)] -- | The signals in the current architecture - -> FApp UnnamedSignal -- | The application to look at. + [(SignalId, SignalInfo)] -- | The signals in the current architecture + -> FApp -- | The application to look at. -> Entity -- | The entity to map against. -> [AST.AssocElem] -- | The resulting port maps @@ -217,7 +217,7 @@ mkAssocElems sigmap app entity = sigs = (map (lookupSigName sigmap) (arg_sigs ++ res_sigs)) -- | Look up a signal in the signal name map -lookupSigName :: [(UnnamedSignal, SignalInfo)] -> UnnamedSignal -> String +lookupSigName :: [(SignalId, SignalInfo)] -> SignalId -> String lookupSigName sigs sig = name where info = Maybe.fromMaybe diff --git a/VHDLTypes.hs b/VHDLTypes.hs index 1704bb8..26ed823 100644 --- a/VHDLTypes.hs +++ b/VHDLTypes.hs @@ -6,10 +6,11 @@ module VHDLTypes where import qualified ForSyDe.Backend.VHDL.AST as AST import FlattenTypes +import HsValueMap -- | A mapping from a haskell structure to the corresponding VHDL port -- signature, or Nothing for values that do not translate to a port. -type VHDLSignalMap = SignalMap (Maybe (AST.VHDLId, AST.TypeMark)) +type VHDLSignalMap = HsValueMap (Maybe (AST.VHDLId, AST.TypeMark)) -- A description of a VHDL entity. Contains both the entity itself as well as -- info on how to map a haskell value (argument / result) on to the entity's