diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-09-20 10:47:18 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2019-09-20 10:50:21 +0100 |
| commit | 1755424806839d57a0c5672922a4b65b838f7d17 (patch) | |
| tree | 01a7702029892bf373f2371824eed0d7b308e2a9 | |
| parent | 1b7e1d31fee4176608e46d45ddc195e313eed978 (diff) | |
| download | haskell-1755424806839d57a0c5672922a4b65b838f7d17.tar.gz | |
Fix PmOracle.addVarCoreCt in-scope set
PmOracle.addVarCoreCt was giving a bogus (empty) in-scope set to
exprIsConApp_maybe, which resulted in a substitution-invariant
failure (see MR !1647 discussion).
This patch fixes it, by taking the free vars of the expression.
| -rw-r--r-- | compiler/coreSyn/CoreSubst.hs | 2 | ||||
| -rw-r--r-- | compiler/deSugar/PmOracle.hs | 12 |
2 files changed, 10 insertions, 4 deletions
diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 2e3a0087f1..afb8946426 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -585,7 +585,7 @@ getTCvSubst :: Subst -> TCvSubst getTCvSubst (Subst in_scope _ tenv cenv) = TCvSubst in_scope tenv cenv -- | See 'Coercion.substCo' -substCo :: Subst -> Coercion -> Coercion +substCo :: HasCallStack => Subst -> Coercion -> Coercion substCo subst co = Coercion.substCo (getTCvSubst subst) co {- diff --git a/compiler/deSugar/PmOracle.hs b/compiler/deSugar/PmOracle.hs index f9abae481c..b321a8f9d1 100644 --- a/compiler/deSugar/PmOracle.hs +++ b/compiler/deSugar/PmOracle.hs @@ -46,6 +46,7 @@ import UniqDFM import Var (EvVar) import Name import CoreSyn +import CoreFVs ( exprFreeVars ) import CoreOpt (exprIsConApp_maybe) import CoreUtils (exprType) import MkCore (mkListExpr, mkCharExpr) @@ -1670,7 +1671,7 @@ addVarCoreCt delta x e = runMaybeT (execStateT (core_expr x e) delta) | Just lit <- coreExprAsPmLit e = pm_lit x lit | Just (_in_scope, _empty_floats@[], dc, _arg_tys, args) - <- exprIsConApp_maybe empty_in_scope e + <- exprIsConApp_maybe in_scope_env e = do { arg_ids <- traverse bind_expr args ; data_con_app x dc arg_ids } -- TODO: Think about how to recognize PatSyns @@ -1680,8 +1681,13 @@ addVarCoreCt delta x e = runMaybeT (execStateT (core_expr x e) delta) -- TODO: Use a CoreMap to identify the CoreExpr with a unique representant = pure () where - empty_in_scope = (emptyInScopeSet, const NoUnfolding) - expr_ty = exprType e + expr_ty = exprType e + expr_in_scope = mkInScopeSet (exprFreeVars e) + in_scope_env = (expr_in_scope, const NoUnfolding) + -- It's inconvenient to get hold of a global in-scope set + -- here, but it'll only be needed if exprIsConApp_maybe ends + -- up substituting inside a forall or lambda (i.e. seldom) + -- so using exprFreeVars seems fine. See MR !1647. bind_expr :: CoreExpr -> StateT Delta (MaybeT DsM) Id bind_expr e = do |