From 62514f77fc32d5381708474142b5bbc1b2c3b033 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 28 Jan 1999 09:43:39 +0000
Subject: [PATCH] [project @ 1999-01-28 09:43:38 by simonpj] Fix lost
specialisations; a one-char change in Simplify.lhs
---
ghc/compiler/simplCore/OccurAnal.lhs | 2 +-
ghc/compiler/simplCore/Simplify.lhs | 10 +++++-----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 7215d93119e3..9bb19b9be050 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -23,7 +23,7 @@ import CmdLineOpts ( SimplifierSwitch(..) )
import CoreSyn
import CoreUtils ( exprIsTrivial, idSpecVars )
import Const ( Con(..), Literal(..) )
-import Id ( idWantsToBeINLINEd,
+import Id ( idWantsToBeINLINEd, isSpecPragmaId,
getInlinePragma, setInlinePragma,
omitIfaceSigForId,
getIdSpecialisation,
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 1ce168cac247..39ff6052e8a3 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -758,7 +758,7 @@ completeBindNonRec bndr rhs thing_inside
simplPrags bndr bndr' etad_rhs `thenSmpl` \ bndr'' ->
modifyInScope bndr'' $
thing_inside `thenSmpl` \ stuff ->
- returnSmpl (addBind (NonRec bndr' etad_rhs) stuff)
+ returnSmpl (addBind (NonRec bndr'' etad_rhs) stuff)
where
etad_rhs = etaCoreExpr rhs
@@ -774,12 +774,12 @@ simplPrags old_bndr new_bndr new_rhs
= returnSmpl (bndr_w_unfolding)
| otherwise
- = pprTrace "simplPrags" (ppr old_bndr) $
- getSimplBinderStuff `thenSmpl` \ (ty_subst, id_subst, in_scope, us) ->
+ = getSimplBinderStuff `thenSmpl` \ (ty_subst, id_subst, in_scope, us) ->
let
- spec_env' = substSpecEnv ty_subst in_scope (subst_val id_subst) spec_env
+ spec_env' = substSpecEnv ty_subst in_scope (subst_val id_subst) spec_env
+ final_bndr = bndr_w_unfolding `setIdSpecialisation` spec_env'
in
- returnSmpl (bndr_w_unfolding `setIdSpecialisation` spec_env')
+ returnSmpl final_bndr
where
bndr_w_unfolding = new_bndr `setIdUnfolding` mkUnfolding new_rhs
--
GitLab