From: Matthijs Kooijman Date: Tue, 17 Feb 2009 15:55:16 +0000 (+0100) Subject: Mark all signals as ports or states when appropriate. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=e2a1b9504807512be2e613c9e8822658be6fa626;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Mark all signals as ports or states when appropriate. Additionally, this differentiates between input and output ports and old and new state. --- diff --git a/Flatten.hs b/Flatten.hs index 12f6ee3..115460c 100644 --- a/Flatten.hs +++ b/Flatten.hs @@ -5,6 +5,7 @@ import qualified Var import qualified Type import qualified Name import qualified Maybe +import qualified Control.Arrow as Arrow import qualified DataCon import qualified CoreUtils import qualified Data.Traversable as Traversable @@ -36,12 +37,15 @@ genSignals ty = -- | Marks a signal as the given SigUse, if its id is in the list of id's -- given. -markSignal :: SigUse -> [UnnamedSignal] -> (UnnamedSignal, SignalInfo) -> (UnnamedSignal, SignalInfo) -markSignal use ids (id, info) = +markSignals :: SigUse -> [UnnamedSignal] -> (UnnamedSignal, SignalInfo) -> (UnnamedSignal, 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 use id = markSignals use [id] + -- | Flatten a haskell function flattenFunction :: HsFunction -- ^ The function to flatten @@ -50,14 +54,22 @@ flattenFunction :: flattenFunction _ (Rec _) = error "Recursive binders not supported" flattenFunction hsfunc bind@(NonRec var expr) = - FlatFunction args res apps conds sigs' + FlatFunction args res apps conds sigs'''' where init_state = ([], [], [], 0) (fres, end_state) = State.runState (flattenExpr [] expr) init_state - (args, res) = fres - portlist = concat (map Foldable.toList (res:args)) (apps, conds, sigs, _) = end_state - sigs' = fmap (markSignal SigPort portlist) sigs + (args, res) = fres + arg_ports = concat (map Foldable.toList args) + res_ports = Foldable.toList res + -- Mark args and result signals as input and output ports resp. + sigs' = fmap (markSignals SigPortIn arg_ports) sigs + sigs'' = fmap (markSignals SigPortOut res_ports) sigs' + -- Mark args and result states as old and new state resp. + args_states = concat $ zipWith stateList (hsFuncArgs hsfunc) args + sigs''' = foldl (\s (num, id) -> map (markSignal (SigStateOld num) id) s) sigs'' args_states + res_states = stateList (hsFuncRes hsfunc) res + sigs'''' = foldl (\s (num, id) -> map (markSignal (SigStateNew num) id) s) sigs''' res_states flattenExpr :: BindMap @@ -193,18 +205,28 @@ appToHsFunction ty f args = hsargs = map (useAsPort . mkHsValueMap . CoreUtils.exprType) args hsres = useAsPort (mkHsValueMap ty) --- | Translates signal id's to SignalInfo for any signals used as state. -findState :: - [(UnnamedSignal, SignalInfo)] -- | A map of id to info - -> UnnamedSignal -- | The signal id to look at - -> HsValueUse -- | How is this signal used? - -> Maybe (Int, SignalInfo) -- | The state num and SignalInfo, if appropriate - -findState sigs id (State num) = - Just (num, Maybe.fromJust $ lookup id sigs) -findState _ _ _ = Nothing - - +-- | Filters non-state signals and returns the state number and signal id for +-- state values. +filterState :: + UnnamedSignal -- | The signal id to look at + -> HsValueUse -- | How is this signal used? + -> Maybe (Int, UnnamedSignal ) -- | The state num and signal id, if this + -- signal was used as state + +filterState id (State num) = + Just (num, id) +filterState _ _ = Nothing + +-- | Returns a list of the state number and signal id of all used-as-state +-- signals in the given maps. +stateList :: + HsUseMap + -> (SignalMap UnnamedSignal) + -> [(Int, UnnamedSignal)] + +stateList uses signals = + Maybe.catMaybes $ Foldable.toList $ zipValueMapsWith filterState signals uses + -- | Returns pairs of signals that should be mapped to state in this function. getOwnStates :: HsFunction -- | The function to look at @@ -221,11 +243,12 @@ getOwnStates hsfunc flatfunc = , old_num == new_num] where sigs = flat_sigs flatfunc - -- Translate args and res to lists of (statenum, SignalInfo) - args = zipWith (zipValueMapsWith $ findState sigs) (flat_args flatfunc) (hsFuncArgs hsfunc) - args_states = Maybe.catMaybes $ concat $ map Foldable.toList $ args - res = zipValueMapsWith (findState sigs) (flat_res flatfunc) (hsFuncRes hsfunc) - res_states = Maybe.catMaybes $ Foldable.toList res + -- Translate args and res to lists of (statenum, sigid) + args = concat $ zipWith stateList (hsFuncArgs hsfunc) (flat_args flatfunc) + res = stateList (hsFuncRes hsfunc) (flat_res flatfunc) + -- Replace the second tuple element with the corresponding SignalInfo + args_states = map (Arrow.second $ signalInfo sigs) args + res_states = map (Arrow.second $ signalInfo sigs) res -- vim: set ts=8 sw=2 sts=2 expandtab: diff --git a/FlattenTypes.hs b/FlattenTypes.hs index e7d21d6..ce1f22d 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -1,5 +1,6 @@ module FlattenTypes where +import qualified Maybe import Data.Traversable import qualified Data.Foldable as Foldable import qualified Control.Monad.State as State @@ -88,10 +89,12 @@ data CondDef sigid = CondDef { -- | How is a given signal used in the resulting VHDL? data SigUse = - SigPort -- | Use as a port - | SigInternal -- | Use as an internal signal - | SigState -- | Use as an internal state - | SigSubState -- | Do not use, state variable is used in a subcircuit + SigPortIn -- | Use as an input port + | SigPortOut -- | Use as an input port + | SigInternal -- | Use as an internal signal + | SigStateOld Int -- | Use as the current internal state + | SigStateNew Int -- | Use as the new internal state + | SigSubState -- | Do not use, state variable is used in a subcircuit -- | Information on a signal definition data SignalInfo = SignalInfo { @@ -109,6 +112,11 @@ data FlatFunction' sigid = FlatFunction { flat_sigs :: [(sigid, 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 sigs id = Maybe.fromJust $ lookup id sigs + -- | A flat function that does not have its signals named type FlatFunction = FlatFunction' UnnamedSignal diff --git a/Pretty.hs b/Pretty.hs index 6564576..7c98404 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -61,9 +61,11 @@ instance Pretty SignalInfo where ppname (Just name) = text ":" <> text name instance Pretty SigUse where - pPrint SigPort = text "P" + pPrint SigPortIn = text "PI" + pPrint SigPortOut = text "PO" pPrint SigInternal = text "I" - pPrint SigState = text "S" + pPrint (SigStateOld n) = text "SO:" <> int n + pPrint (SigStateNew n) = text "SN:" <> int n pPrint SigSubState = text "s" instance Pretty VHDLSession where