diff options
Diffstat (limited to 'compiler/specialise/SpecConstr.lhs')
| -rw-r--r-- | compiler/specialise/SpecConstr.lhs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index d2c07bcc1b..995d6212ce 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -627,7 +627,8 @@ specConstrProgram guts %************************************************************************ \begin{code} -data ScEnv = SCE { sc_size :: Maybe Int, -- Size threshold +data ScEnv = SCE { sc_dflags :: DynFlags, + 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? @@ -672,7 +673,8 @@ instance Outputable Value where --------------------- initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv initScEnv dflags anns - = SCE { sc_size = specConstrThreshold dflags, + = SCE { sc_dflags = dflags, + sc_size = specConstrThreshold dflags, sc_count = specConstrCount dflags, sc_force = False, sc_subst = emptySubst, @@ -1023,7 +1025,7 @@ scExpr' env (Case scrut b ty alts) where sc_con_app con args scrut' -- Known constructor; simplify = do { let (_, bs, rhs) = findAlt con alts - `orElse` (DEFAULT, [], mkImpossibleExpr (coreAltsType alts)) + `orElse` (DEFAULT, [], mkImpossibleExpr ty) alt_env' = extendScSubstList env ((b,scrut') : bs `zip` trimConArgs con args) ; scExpr alt_env' rhs } @@ -1034,7 +1036,7 @@ scExpr' env (Case scrut b ty alts) ; (alt_usgs, alt_occs, alts') <- mapAndUnzip3M (sc_alt alt_env scrut' b') alts - ; let scrut_occ = foldr1 combineOcc alt_occs -- Never empty + ; let scrut_occ = foldr combineOcc NoOcc alt_occs scrut_usg' = setScrutOcc env scrut_usg scrut' scrut_occ -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to scScrut, which @@ -1384,7 +1386,8 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number) fn_name = idName fn fn_loc = nameSrcSpan fn_name spec_occ = mkSpecOcc (nameOccName fn_name) - rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number)) + dflags = sc_dflags env + rule_name = mkFastString ("SC:" ++ showSDoc dflags (ppr fn <> int rule_number)) spec_name = mkInternalName spec_uniq spec_occ fn_loc -- ; pprTrace "{spec_one" (ppr (sc_count env) <+> ppr fn <+> ppr pats <+> text "-->" <+> ppr spec_name) $ -- return () |