From 1de7e7d5eb0c3fd3be4a348e10fec91c7f3d029d Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Wed, 11 Feb 2009 20:01:44 +0100 Subject: [PATCH] Remove the distinction between SignalDef and SignalUse. Now everywhere SignalDef and SignalUse was used before, the sigid is used directly. --- Flatten.hs | 22 +++++++++++----------- FlattenTypes.hs | 46 +++++++++++++--------------------------------- Pretty.hs | 6 ------ 3 files changed, 24 insertions(+), 50 deletions(-) diff --git a/Flatten.hs b/Flatten.hs index e550db8..15f9980 100644 --- a/Flatten.hs +++ b/Flatten.hs @@ -23,11 +23,11 @@ dataConAppArgs dc args = where tycount = length $ DataCon.dataConAllTyVars dc -genSignalUses :: +genSignals :: Type.Type - -> FlattenState (SignalUseMap UnnamedSignal) + -> FlattenState (SignalMap UnnamedSignal) -genSignalUses ty = do +genSignals ty = do typeMapToUseMap tymap where -- First generate a map with the right structure containing the types @@ -35,11 +35,11 @@ genSignalUses ty = do typeMapToUseMap :: HsValueMap Type.Type - -> FlattenState (SignalUseMap UnnamedSignal) + -> FlattenState (SignalMap UnnamedSignal) typeMapToUseMap (Single ty) = do id <- genSignalId - return $ Single (SignalUse id) + return $ Single id typeMapToUseMap (Tuple tymaps) = do usemaps <- State.mapM typeMapToUseMap tymaps @@ -63,16 +63,16 @@ flattenFunction hsfunc bind@(NonRec var expr) = flattenExpr :: BindMap -> CoreExpr - -> FlattenState ([SignalDefMap UnnamedSignal], (SignalUseMap UnnamedSignal)) + -> FlattenState ([SignalMap UnnamedSignal], (SignalMap UnnamedSignal)) flattenExpr binds lam@(Lam b expr) = do -- Find the type of the binder let (arg_ty, _) = Type.splitFunTy (CoreUtils.exprType lam) -- Create signal names for the binder - defs <- genSignalUses arg_ty + defs <- genSignals arg_ty let binds' = (b, Left defs):binds (args, res) <- flattenExpr binds' expr - return ((useMapToDefMap defs) : args, res) + return (defs : args, res) flattenExpr binds (Var id) = case bind of @@ -114,12 +114,12 @@ flattenExpr binds app@(App _ _) = do -- Check and split each of the arguments let (_, arg_ress) = unzip (zipWith checkArg args flat_args) -- Generate signals for our result - res <- genSignalUses ty + res <- genSignals ty -- Create the function application let app = FApp { appFunc = func, appArgs = arg_ress, - appRes = useMapToDefMap res + appRes = res } addApp app return ([], res) @@ -154,7 +154,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 ( [SignalDefMap UnnamedSignal], SignalUseMap UnnamedSignal) + -> FlattenState ( [SignalMap UnnamedSignal], SignalMap UnnamedSignal) -- See expandExpr flattenSingleAltCaseExpr binds v b alt@(DataAlt datacon, bind_vars, expr) = if not (DataCon.isTupleCon datacon) diff --git a/FlattenTypes.hs b/FlattenTypes.hs index c5546ea..3389a5b 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -10,28 +10,8 @@ import HsValueMap -- | A signal identifier type UnnamedSignal = Int --- | A use of a signal -data SignalUse sigid = SignalUse { - sigUseId :: sigid -} deriving (Show, Eq) - --- | A def of a signal -data SignalDef sigid = SignalDef { - sigDefId :: sigid -} deriving (Show, Eq) - --- | A map of a Haskell value to signal uses -type SignalUseMap sigid = HsValueMap (SignalUse sigid) --- | A map of a Haskell value to signal defs -type SignalDefMap sigid = HsValueMap (SignalDef sigid) - --- | Translate a SignalUseMap to an equivalent SignalDefMap -useMapToDefMap :: SignalUseMap sigid -> SignalDefMap sigid -useMapToDefMap = fmap (\(SignalUse u) -> SignalDef u) - --- | Translate a SignalDefMap to an equivalent SignalUseMap -defMapToUseMap :: SignalDefMap sigid -> SignalUseMap sigid -defMapToUseMap = fmap (\(SignalDef u) -> SignalUse u) +-- | A map of a Haskell value to signal ids +type SignalMap sigid = HsValueMap sigid -- | How is a given (single) value in a function's type (ie, argument or -- return value) used? @@ -82,23 +62,23 @@ data HsFunction = HsFunction { -- | A flattened function application data FApp sigid = FApp { appFunc :: HsFunction, - appArgs :: [SignalUseMap sigid], - appRes :: SignalDefMap sigid + appArgs :: [SignalMap sigid], + appRes :: SignalMap sigid } deriving (Show, Eq) -- | A conditional signal definition data CondDef sigid = CondDef { - cond :: SignalUse sigid, - high :: SignalUse sigid, - low :: SignalUse sigid, - condRes :: SignalDef sigid + cond :: sigid, + high :: sigid, + low :: sigid, + condRes :: sigid } deriving (Show, Eq) -- | A flattened function data FlatFunction' sigid = FlatFunction { - args :: [SignalDefMap sigid], - res :: SignalUseMap sigid, - --sigs :: [SignalDef], + args :: [SignalMap sigid], + res :: SignalMap sigid, + --sigs :: [Signal], apps :: [FApp sigid], conds :: [CondDef sigid] } deriving (Show, Eq) @@ -110,11 +90,11 @@ type FlatFunction = FlatFunction' UnnamedSignal type BindMap = [( CoreBndr, -- ^ The bind name Either -- ^ The bind value which is either - (SignalUseMap UnnamedSignal) + (SignalMap UnnamedSignal) -- ^ a signal ( HsValueUse, -- ^ or a HighOrder function - [SignalUse UnnamedSignal] -- ^ With these signals already applied to it + [UnnamedSignal] -- ^ With these signals already applied to it ) )] diff --git a/Pretty.hs b/Pretty.hs index bd4d9e5..22862d5 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -38,12 +38,6 @@ instance Pretty id => Pretty (FApp id) where pPrint (FApp func args res) = pPrint func <> text " : " <> pPrint args <> text " -> " <> pPrint res -instance Pretty id => Pretty (SignalDef id) where - pPrint (SignalDef id) = pPrint id - -instance Pretty id => Pretty (SignalUse id) where - pPrint (SignalUse id) = pPrint id - instance Pretty id => Pretty (CondDef id) where pPrint _ = text "TODO" -- 2.30.2