[commit: ghc] master: Improve the runRW magic in CorePrep (d990354)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d990354473239943d83ee90f8906f3737b53fe65/ghc

>---------------------------------------------------------------

commit d990354473239943d83ee90f8906f3737b53fe65
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Dec 24 14:42:34 2015 +0000

    Improve the runRW magic in CorePrep
    
    Instead of substituting, just augment the environment.
    Less code, more efficient.
    
    And the previous version had a bogus in-scope set which
    triggered a WARNING


>---------------------------------------------------------------

d990354473239943d83ee90f8906f3737b53fe65
 compiler/coreSyn/CorePrep.hs | 20 ++++++++------------
 1 file changed, 8 insertions(+), 12 deletions(-)

diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 70eb1a1..8b4b13b 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -516,15 +516,11 @@ cpeRhsE env (Var f `App` _{-type-} `App` arg)
   | f `hasKey` lazyIdKey          -- Replace (lazy a) by a
   = cpeRhsE env arg               -- See Note [lazyId magic] in MkId
 
-cpeRhsE env (Var f `App` _{-levity-} `App` _{-type-} `App` arg)
+cpeRhsE env (Var f `App` _levity `App` _type `App` arg)
     -- See Note [runRW magic] in MkId
   | f `hasKey` runRWKey           -- Replace (runRW# f) by (f realWorld#),
   = case arg of                   -- beta reducing if possible
-      Lam s body -> cpeRhsE env (substExpr (text "runRW#") subst body)
-        where subst = extendIdSubst emptySubst s (Var realWorldPrimId)
-                      -- XXX I think we can use emptySubst here
-                      -- because realWorldPrimId is a global variable
-                      -- and so cannot be bound by a lambda in body
+      Lam s body -> cpeRhsE (extendCorePrepEnv env s realWorldPrimId) body
       _          -> cpeRhsE env (arg `App` Var realWorldPrimId)
 
 cpeRhsE env expr@(App {}) = cpeApp env expr
@@ -1161,12 +1157,12 @@ allLazyNested is_rec (Floats IfUnboxedOk _) = isNonRec is_rec
 --                      The environment
 -- ---------------------------------------------------------------------------
 
-data CorePrepEnv = CPE {
-                       cpe_dynFlags    :: DynFlags,
-                       cpe_env         :: (IdEnv Id), -- Clone local Ids
-                       cpe_mkIntegerId :: Id,
-                       cpe_integerSDataCon :: Maybe DataCon
-                   }
+data CorePrepEnv
+  = CPE { cpe_dynFlags        :: DynFlags
+        , cpe_env             :: IdEnv Id   -- Clone local Ids
+        , cpe_mkIntegerId     :: Id
+        , cpe_integerSDataCon :: Maybe DataCon
+    }
 
 lookupMkIntegerName :: DynFlags -> HscEnv -> IO Id
 lookupMkIntegerName dflags hsc_env