From: simonpj <unknown>
Date: Thu, 28 Jan 1999 09:43:39 +0000 (+0000)
Subject: [project @ 1999-01-28 09:43:38 by simonpj]
X-Git-Tag: Approximately_9120_patches~6670
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=62514f77fc32d5381708474142b5bbc1b2c3b033;p=ghc-hetmet.git

[project @ 1999-01-28 09:43:38 by simonpj]
Fix lost specialisations; a one-char change in Simplify.lhs
---

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 7215d93..9bb19b9 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 1ce168c..39ff605 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