summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/SimpleOpt.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2020-06-18 09:38:00 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2020-06-18 22:39:53 +0100
commitc07cbba91a586bbaf08d3b60dbc2dc13f1b0421e (patch)
treea1b4d2c7dfb7e9e1ba881a1c99fb296e9c127d60 /compiler/GHC/Core/SimpleOpt.hs
parentfa4281d672e462b8421098b3506bd3c4c6a1f819 (diff)
downloadhaskell-wip/T18347.tar.gz
Fix a buglet in Simplify.simplCastwip/T18347
This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj@microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal
Diffstat (limited to 'compiler/GHC/Core/SimpleOpt.hs')
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs24
1 files changed, 15 insertions, 9 deletions
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 87ad9e69c5..9901f752b1 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -213,6 +213,7 @@ simple_opt_expr env expr
in_scope = substInScope subst
in_scope_env = (in_scope, simpleUnfoldingFun)
+ ---------------
go (Var v)
| Just clo <- lookupVarEnv (soe_inl env) v
= simple_opt_clo env clo
@@ -221,17 +222,10 @@ simple_opt_expr env expr
go (App e1 e2) = simple_app env e1 [(env,e2)]
go (Type ty) = Type (substTy subst ty)
- go (Coercion co) = Coercion (optCoercion (soe_dflags env) (getTCvSubst subst) co)
+ go (Coercion co) = Coercion (go_co co)
go (Lit lit) = Lit lit
go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)
- go (Cast e co) = case go e of
- -- flatten nested casts before calling the coercion optimizer;
- -- see #18112 (note that mkCast handles dropping Refl coercions)
- Cast e' co' -> mkCast e' (opt_co (mkTransCo co' co))
- e' -> mkCast e' (opt_co co)
- where
- opt_co = optCoercion (soe_dflags env) (getTCvSubst subst)
-
+ go (Cast e co) = mk_cast (go e) (go_co co)
go (Let bind body) = case simple_opt_bind env bind NotTopLevel of
(env', Nothing) -> simple_opt_expr env' body
(env', Just bind) -> Let bind (simple_opt_expr env' body)
@@ -267,6 +261,9 @@ simple_opt_expr env expr
(env', b') = subst_opt_bndr env b
----------------------
+ go_co co = optCoercion (soe_dflags env) (getTCvSubst subst) co
+
+ ----------------------
go_alt env (con, bndrs, rhs)
= (con, bndrs', simple_opt_expr env' rhs)
where
@@ -285,6 +282,15 @@ simple_opt_expr env expr
bs = reverse bs'
e' = simple_opt_expr env e
+mk_cast :: CoreExpr -> CoercionR -> CoreExpr
+-- Like GHC.Core.Utils.mkCast, but does a full reflexivity check.
+-- mkCast doesn't do that because the Simplifier does (in simplCast)
+-- But in SimpleOpt it's nice to kill those nested casts (#18112)
+mk_cast (Cast e co1) co2 = mk_cast e (co1 `mkTransCo` co2)
+mk_cast (Tick t e) co = Tick t (mk_cast e co)
+mk_cast e co | isReflexiveCo co = e
+ | otherwise = Cast e co
+
----------------------
-- simple_app collects arguments for beta reduction
simple_app :: SimpleOptEnv -> InExpr -> [SimpleClo] -> CoreExpr