[commit: ghc] master: CSE.cseOneExpr: Set InScopeSet correctly (fee253f)

[git at git.haskell.org]

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

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

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

commit fee253fc48d80b0cbd29ec90b5377c1981eb888f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Aug 18 14:14:19 2017 +0200

    CSE.cseOneExpr: Set InScopeSet correctly
    
    because this is a convenience function for API users, calculate the
    in-scope set from `exprFreeVars`.


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

fee253fc48d80b0cbd29ec90b5377c1981eb888f
 compiler/simplCore/CSE.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index ccbdf35..ffbcdb4 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -12,13 +12,14 @@ module CSE (cseProgram, cseOneExpr) where
 
 import CoreSubst
 import Var              ( Var )
-import VarEnv           ( elemInScopeSet )
+import VarEnv           ( elemInScopeSet, mkInScopeSet )
 import Id               ( Id, idType, idInlineActivation, isDeadBinder
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
                         , isJoinId )
 import CoreUtils        ( mkAltExpr, eqExpr
                         , exprIsLiteralString
                         , stripTicksE, stripTicksT, mkTicks )
+import CoreFVs          ( exprFreeVars )
 import Type             ( tyConAppArgs )
 import CoreSyn
 import Outputable
@@ -444,8 +445,13 @@ tryForCSE env expr
     -- top of the replaced sub-expression. This is probably not too
     -- useful in practice, but upholds our semantics.
 
+-- | Runs CSE on a single expression.
+--
+-- This entry point is not used in the compiler itself, but is provided
+-- as a convenient entry point for users of the GHC API.
 cseOneExpr :: InExpr -> OutExpr
-cseOneExpr = cseExpr emptyCSEnv
+cseOneExpr e = cseExpr env e
+  where env = emptyCSEnv {cs_subst = mkEmptySubst (mkInScopeSet (exprFreeVars e)) }
 
 cseExpr :: CSEnv -> InExpr -> OutExpr
 cseExpr env (Type t)              = Type (substTy (csEnvSubst env) t)