[commit: ghc] wip/T15155: Revert "WIP: triggering CI for Simon's patch" (0bf9705)

[git at git.haskell.org]

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

On branch  : wip/T15155
Link       : http://ghc.haskell.org/trac/ghc/changeset/0bf9705463ba3f2caeeb479548468d24d97fa703/ghc

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

commit 0bf9705463ba3f2caeeb479548468d24d97fa703
Author: Gabor Greif <ggreif at gmail.com>
Date:   Thu May 24 11:11:11 2018 +0200

    Revert "WIP: triggering CI for Simon's patch"
    
    This reverts commit 1407258585a5d65f90b82516f83b5cadb3101541.


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

0bf9705463ba3f2caeeb479548468d24d97fa703
 compiler/codeGen/StgCmmClosure.hs |  8 --------
 compiler/coreSyn/CoreOpt.hs       | 20 +-------------------
 compiler/prelude/PrelRules.hs     |  9 +++++++--
 3 files changed, 8 insertions(+), 29 deletions(-)

diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index c051c91..b021fe0 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -68,8 +68,6 @@ module StgCmmClosure (
 
 import GhcPrelude
 
-import CoreSyn( isValueUnfolding, maybeUnfoldingTemplate )
-import CoreOpt( exprIsSatConApp_maybe )
 import StgSyn
 import SMRep
 import Cmm
@@ -329,11 +327,6 @@ mkLFImported id
                 -- We assume that the constructor is evaluated so that
                 -- the id really does point directly to the constructor
 
-  | isValueUnfolding unf
-  , Just expr <- maybeUnfoldingTemplate unf
-  , Just con <- exprIsSatConApp_maybe expr
-  = LFCon con
-
   | arity > 0
   = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr")
 
@@ -341,7 +334,6 @@ mkLFImported id
   = mkLFArgument id -- Not sure of exact arity
   where
     arity = idFunRepArity id
-    unf   = realIdUnfolding id
 
 -------------
 mkLFStringLit :: LambdaFormInfo
diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 816c5e2..2027928 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -12,8 +12,7 @@ module CoreOpt (
         joinPointBinding_maybe, joinPointBindings_maybe,
 
         -- ** Predicates on expressions
-        exprIsConApp_maybe, exprIsLiteral_maybe,
-        exprIsLambda_maybe, exprIsSatConApp_maybe,
+        exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,
 
         -- ** Coercions and casts
         pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo
@@ -813,23 +812,6 @@ exprIsConApp_maybe (in_scope, id_unf) expr
     extend (Right s)       v e = Right (extendSubst s v e)
 
 
-exprIsSatConApp_maybe :: CoreExpr -> Maybe DataCon
--- Returns (Just dc) for a saturated application of dc
--- Simpler than exprIsConApp_maybe
-exprIsSatConApp_maybe e = go 0 e
-  where
-    go :: Arity -> CoreExpr -> Maybe DataCon
-    go n_val_args (Var v)
-       | Just dc <- isDataConWorkId_maybe v
-       , dataConRepArity dc == n_val_args
-       = Just dc
-    go n_val_args (App f a)
-       | isTypeArg a = go n_val_args       f
-       | otherwise   = go (n_val_args + 1) f
-    go n_val_args (Cast e _) = go n_val_args e
-    go n_val_args (Tick _ e) = go n_val_args e
-    go _ _ = Nothing
-
 -- See Note [exprIsConApp_maybe on literal strings]
 dealWithStringLiteral :: Var -> BS.ByteString -> Coercion
                       -> Maybe (DataCon, [Type], [CoreExpr])
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index a1f0b0b..d0ad6c5 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -33,7 +33,7 @@ import CoreSyn
 import MkCore
 import Id
 import Literal
-import CoreOpt     ( exprIsLiteral_maybe, exprIsSatConApp_maybe )
+import CoreOpt     ( exprIsLiteral_maybe )
 import PrimOp      ( PrimOp(..), tagToEnumKey )
 import TysWiredIn
 import TysPrim
@@ -41,6 +41,7 @@ import TyCon       ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
                    , isNewTyCon, unwrapNewTyCon_maybe, tyConDataCons )
 import DataCon     ( DataCon, dataConTagZ, dataConTyCon, dataConWorkId )
 import CoreUtils   ( cheapEqExpr, exprIsHNF, exprType )
+import CoreUnfold  ( exprIsConApp_maybe )
 import Type
 import OccName     ( occNameFS )
 import PrelNames
@@ -744,6 +745,9 @@ removeOp32 = do
 getArgs :: RuleM [CoreExpr]
 getArgs = RuleM $ \_ _ args -> Just args
 
+getInScopeEnv :: RuleM InScopeEnv
+getInScopeEnv = RuleM $ \_ iu _ -> Just iu
+
 -- return the n-th argument of this rule, if it is a literal
 -- argument indices start from 0
 getLiteral :: Int -> RuleM Literal
@@ -1002,7 +1006,8 @@ dataToTagRule = a `mplus` b
     b = do
       dflags <- getDynFlags
       [_, val_arg] <- getArgs
-      dc <- liftMaybe $ exprIsSatConApp_maybe val_arg
+      in_scope <- getInScopeEnv
+      (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg
       ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return ()
       return $ mkIntVal dflags (toInteger (dataConTagZ dc))