+ToDo [Nov 2010]
+~~~~~~~~~~~~~~~
+1. Use a library type rather than an annotation for ForceSpecConstr
+2. Nuke NoSpecConstr
+
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
* And lastly, the SPEC argument is ultimately eliminated by
SpecConstr itself so there is no runtime overhead.
-This is all quite ugly; we ought to come
-up with a better design.
+This is all quite ugly; we ought to come up with a better design.
ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set
-force_spec to True when calling specLoop. This flag makes specLoop and
-specialise ignore specConstrCount and specConstrThreshold when deciding
-whether to specialise a function.
+sc_force to True when calling specLoop. This flag does three things:
+ * Ignore specConstrThreshold, to specialise functions of arbitrary size
+ (see scTopBind)
+ * Ignore specConstrCount, to make arbitrary numbers of specialisations
+ (see specialise)
+ * Specialise even for arguments that are not scrutinised in the loop
+ (see argToPat; Trac #4488)
What alternatives did I consider? Annotating the loop itself doesn't
work because (a) it is local and (b) it will be w/w'ed and I having
types of the loop arguments really seem to be the most persistent
thing.
-Annotating the types that make up the loop state s doesn't work,
+Annotating the types that make up the loop state doesn't work,
either, because (a) it would prevent us from using types like Either
or tuples here, (b) we don't want to restrict the set of types that
can be used in Stream states and (c) some types are fixed by the user
(e.g., the accumulator here) but we still want to specialise as much
as possible.
+ForceSpecConstr is done by way of an annotation:
+ data SPEC = SPEC | SPEC2
+ {-# ANN type SPEC ForceSpecConstr #-}
+But SPEC is the *only* type so annotated, so it'd be better to
+use a particular library type.
+
+Alternatives to ForceSpecConstr
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Instead of giving the loop an extra argument of type SPEC, we
+also considered *wrapping* arguments in SPEC, thus
+ data SPEC a = SPEC a | SPEC2
+
+ loop = \arg -> case arg of
+ SPEC state ->
+ case state of (x,y) -> ... loop (SPEC (x',y')) ...
+ S2 -> error ...
+The idea is that a SPEC argument says "specialise this argument
+regardless of whether the function case-analyses it. But this
+doesn't work well:
+ * SPEC must still be a sum type, else the strictness analyser
+ eliminates it
+ * But that means that 'loop' won't be strict in its real payload
+This loss of strictness in turn screws up specialisation, because
+we may end up with calls like
+ loop (SPEC (case z of (p,q) -> (q,p)))
+Without the SPEC, if 'loop' was strict, the case would move out
+and we'd see loop applied to a pair. But if 'loop' isn' strict
+this doesn't look like a specialisable call.
+
+Note [NoSpecConstr]
+~~~~~~~~~~~~~~~~~~~
+The ignoreAltCon stuff allows you to say
+ {-# ANN type T NoSpecConstr #-}
+to mean "don't specialise on arguments of this type. It was added
+before we had ForceSpecConstr. Lacking ForceSpecConstr we specialised
+regardless of size; and then we needed a way to turn that *off*. Now
+that we have ForceSpecConstr, this NoSpecConstr is probably redundant.
+(Used only for PArray.)
+
-----------------------------------------------------
Stuff not yet handled
-----------------------------------------------------
data ScEnv = SCE { sc_size :: Maybe Int, -- Size threshold
sc_count :: Maybe Int, -- Max # of specialisations for any one fn
-- See Note [Avoiding exponential blowup]
+ sc_force :: Bool, -- Force specialisation?
+ -- See Note [Forcing specialisation]
sc_subst :: Subst, -- Current substitution
-- Maps InIds to OutExprs
initScEnv dflags anns
= SCE { sc_size = specConstrThreshold dflags,
sc_count = specConstrCount dflags,
+ sc_force = False,
sc_subst = emptySubst,
sc_how_bound = emptyVarEnv,
sc_vals = emptyVarEnv,
ppr RecFun = text "RecFun"
ppr RecArg = text "RecArg"
+scForce :: ScEnv -> Bool -> ScEnv
+scForce env b = env { sc_force = b }
+
lookupHowBound :: ScEnv -> Id -> Maybe HowBound
lookupHowBound env id = lookupVarEnv (sc_how_bound env) id
-- NB: We don't use the ForceSpecConstr mechanism (see
-- Note [Forcing specialisation]) for non-recursive bindings
-- at the moment. I'm not sure if this is the right thing to do.
- ; let force_spec = False
- ; (spec_usg, specs) <- specialise env force_spec
+ ; let env' = scForce env False
+ ; (spec_usg, specs) <- specialise env'
(scu_calls body_usg)
rhs_info
(SI [] 0 (Just rhs_usg))
; (body_usg, body') <- scExpr rhs_env2 body
-- NB: start specLoop from body_usg
- ; (spec_usg, specs) <- specLoop rhs_env2 force_spec
+ ; (spec_usg, specs) <- specLoop (scForce rhs_env2 force_spec)
(scu_calls body_usg) rhs_infos nullUsage
[SI [] 0 (Just usg) | usg <- rhs_usgs]
-- Do not unconditionally use rhs_usgs.
; (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs rhs_env2) (bndrs' `zip` rhss)
; let rhs_usg = combineUsages rhs_usgs
- ; (_, specs) <- specLoop rhs_env2 force_spec
+ ; (_, specs) <- specLoop (scForce rhs_env2 force_spec)
(scu_calls rhs_usg) rhs_infos nullUsage
[SI [] 0 Nothing | _ <- bndrs]
specLoop :: ScEnv
- -> Bool -- force specialisation?
- -- Note [Forcing specialisation]
-> CallEnv
-> [RhsInfo]
-> ScUsage -> [SpecInfo] -- One per binder; acccumulating parameter
-> UniqSM (ScUsage, [SpecInfo]) -- ...ditto...
-specLoop env force_spec all_calls rhs_infos usg_so_far specs_so_far
- = do { specs_w_usg <- zipWithM (specialise env force_spec all_calls) rhs_infos specs_so_far
+specLoop env all_calls rhs_infos usg_so_far specs_so_far
+ = do { specs_w_usg <- zipWithM (specialise env all_calls) rhs_infos specs_so_far
; let (new_usg_s, all_specs) = unzip specs_w_usg
new_usg = combineUsages new_usg_s
new_calls = scu_calls new_usg
; if isEmptyVarEnv new_calls then
return (all_usg, all_specs)
else
- specLoop env force_spec new_calls rhs_infos all_usg all_specs }
+ specLoop env new_calls rhs_infos all_usg all_specs }
specialise
:: ScEnv
- -> Bool -- force specialisation?
- -- Note [Forcing specialisation]
-> CallEnv -- Info on calls
-> RhsInfo
-> SpecInfo -- Original RHS plus patterns dealt with
-- So when we make a specialised copy of the RHS, we're starting
-- from an RHS whose nested functions have been optimised already.
-specialise env force_spec bind_calls (RI fn _ arg_bndrs body arg_occs)
- spec_info@(SI specs spec_count mb_unspec)
+specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
+ spec_info@(SI specs spec_count mb_unspec)
| not (isBottomingId fn) -- Note [Do not specialise diverging functions]
, not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation]
, notNull arg_bndrs -- Only specialise functions
; let n_pats = length pats
spec_count' = n_pats + spec_count
; case sc_count env of
- Just max | not force_spec && spec_count' > max
+ Just max | not (sc_force env) && spec_count' > max
-> pprTrace "SpecConstr" msg $
return (nullUsage, spec_info)
where
-- NB: this *precedes* the Var case, so that we catch nullary constrs
argToPat env in_scope val_env arg arg_occ
| Just (ConVal dc args) <- isValue val_env arg
- , not (ignoreAltCon env dc)
- , case arg_occ of
- ScrutOcc _ -> True -- Used only by case scrutinee
- BothOcc -> case arg of -- Used elsewhere
- App {} -> True -- see Note [Reboxing]
- _other -> False
- _other -> False -- No point; the arg is not decomposed
+ , not (ignoreAltCon env dc) -- See Note [NoSpecConstr]
+ , sc_force env || scrutinised
= do { args' <- argsToPats env in_scope val_env (args `zip` conArgOccs arg_occ dc)
; return (True, mk_con_app dc (map snd args')) }
+ where
+ scrutinised
+ = case arg_occ of
+ ScrutOcc _ -> True -- Used only by case scrutinee
+ BothOcc -> case arg of -- Used elsewhere
+ App {} -> True -- see Note [Reboxing]
+ _other -> False
+ _other -> False -- No point; the arg is not decomposed
+
-- Check if the argument is a variable that
-- is in scope at the function definition site
-- (a) it's used in an interesting way in the body
-- (b) we know what its value is
argToPat env in_scope val_env (Var v) arg_occ
- | case arg_occ of { UnkOcc -> False; _other -> True }, -- (a)
- is_value, -- (b)
+ | sc_force env || case arg_occ of { UnkOcc -> False; _other -> True }, -- (a)
+ is_value, -- (b)
not (ignoreType env (varType v))
= return (True, Var v)
where
projects / ghc-hetmet.git / blobdiff