diff options
Diffstat (limited to 'compiler/stranal')
| -rw-r--r-- | compiler/stranal/DmdAnal.lhs | 2 | ||||
| -rw-r--r-- | compiler/stranal/WorkWrap.lhs | 2 | ||||
| -rw-r--r-- | compiler/stranal/WwLib.lhs | 6 |
3 files changed, 5 insertions, 5 deletions
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index afa722fa8a..a643949a2a 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -547,7 +547,7 @@ dmdAnalRhs top_lvl rec_flag env (id, rhs) arity = idArity id -- The idArity should be up to date -- The simplifier was run just beforehand (rhs_dmd_ty, rhs') = dmdAnal env (vanillaCall arity) rhs - (lazy_fv, sig_ty) = WARN( arity /= dmdTypeDepth rhs_dmd_ty && not (exprIsTrivial rhs), ppr id ) + (lazy_fv, sig_ty) = WARN( dflags, arity /= dmdTypeDepth rhs_dmd_ty && not (exprIsTrivial rhs), ppr id ) -- The RHS can be eta-reduced to just a variable, -- in which case we should not complain. mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs index ac10b1b773..e93a739919 100644 --- a/compiler/stranal/WorkWrap.lhs +++ b/compiler/stranal/WorkWrap.lhs @@ -308,7 +308,7 @@ checkSize fn_id rhs thing_inside splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Expr Var -> UniqSM [(Id, CoreExpr)] splitFun fn_id fn_info wrap_dmds res_info rhs - = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) + = WARN( dflags, not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) (do { -- The arity should match the signature (work_demands, wrap_fn, work_fn) <- mkWwBodies fun_ty wrap_dmds res_info one_shots diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 391c07c089..cd1b53b9de 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -274,7 +274,7 @@ mkWWargs subst fun_ty arg_info res_ty) } | otherwise - = WARN( True, ppr fun_ty ) -- Should not happen: if there is a demand + = WARN( dflags, True, ppr fun_ty ) -- Should not happen: if there is a demand return ([], id, id, substTy subst fun_ty) -- then there should be a function arrow applyToVars :: [Var] -> CoreExpr -> CoreExpr @@ -424,7 +424,7 @@ mkWWcpr :: Type -- function body type mkWWcpr body_ty RetCPR | not (isClosedAlgType body_ty) - = WARN( True, + = WARN( dflags, True, text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty ) return (id, id, body_ty) @@ -521,7 +521,7 @@ mk_absent_let arg | arg_ty `eqType` realWorldStatePrimTy = Just (Let (NonRec arg (Var realWorldPrimId))) | otherwise - = WARN( True, ptext (sLit "No absent value for") <+> ppr arg_ty ) + = WARN( dflags, True, ptext (sLit "No absent value for") <+> ppr arg_ty ) Nothing where arg_ty = idType arg |