diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-25 12:24:55 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-08-25 13:39:15 +0100 |
commit | c0fe1d9e7a9f23d050319c77f3a38264f3aa22f8 (patch) | |
tree | f69a18f4c18cf9b0e66a1182d4d04b0e01880cc6 /compiler | |
parent | 9f8754eb46b59886ebc09dec2581ed31eea053dc (diff) | |
download | haskell-c0fe1d9e7a9f23d050319c77f3a38264f3aa22f8.tar.gz |
Introduce the Call data types
This is just a small refactoring that makes the code a bit clearer,
using a data type instead of a triple. We get better pretty-printing too.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/specialise/SpecConstr.lhs | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 24820eba40..a202ce55fd 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -35,6 +35,7 @@ import Rules import Type hiding ( substTy ) import TyCon ( isRecursiveTyCon, tyConName ) import Id +import PprCore ( pprParendExpr ) import MkCore ( mkImpossibleExpr ) import Var import VarEnv @@ -1019,15 +1020,27 @@ data ScUsage } -- The domain is OutIds type CallEnv = IdEnv [Call] -type Call = (ValueEnv, [CoreArg]) +data Call = Call Id [CoreArg] ValueEnv -- The arguments of the call, together with the -- env giving the constructor bindings at the call site + -- We keep the function mainly for debug output + +instance Outputable Call where + ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args) nullUsage :: ScUsage nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv } combineCalls :: CallEnv -> CallEnv -> CallEnv combineCalls = plusVarEnv_C (++) + where +-- plus cs ds | length res > 1 +-- = pprTrace "combineCalls" (vcat [ ptext (sLit "cs:") <+> ppr cs +-- , ptext (sLit "ds:") <+> ppr ds]) +-- res +-- | otherwise = res +-- where +-- res = cs ++ ds combineUsage :: ScUsage -> ScUsage -> ScUsage combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2), @@ -1285,7 +1298,7 @@ scApp env (other_fn, args) mkVarUsage :: ScEnv -> Id -> [CoreExpr] -> ScUsage mkVarUsage env fn args = case lookupHowBound env fn of - Just RecFun -> SCU { scu_calls = unitVarEnv fn [(sc_vals env, args)] + Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env)] , scu_occs = emptyVarEnv } Just RecArg -> SCU { scu_calls = emptyVarEnv , scu_occs = unitVarEnv fn arg_occ } @@ -1711,7 +1724,7 @@ callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe (CallPat, ValueEnv)) -- Type variables come first, since they may scope -- over the following term variables -- The [CoreExpr] are the argument patterns for the rule -callToPats env bndr_occs (con_env, args) +callToPats env bndr_occs (Call _ args con_env) | length args < length bndr_occs -- Check saturated = return Nothing | otherwise |