[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 (file)
--- 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 (file)
--- 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