[Git][ghc/ghc][wip/dmdanal-precise-exn] Revert "Change forcesRealWorld to work like the old IO hack"

[Sebastian Graf]

Sebastian Graf pushed to branch wip/dmdanal-precise-exn at Glasgow Haskell Compiler / GHC


Commits:
8ebfdf4f by Sebastian Graf at 2020-03-29T17:09:50+02:00
Revert "Change forcesRealWorld to work like the old IO hack"

This reverts commit 516987db1eb32bb231063e1e0fa4ff78178b15c9.

- - - - -


1 changed file:

- compiler/GHC/Core/Op/DmdAnal.hs


Changes:

=====================================
compiler/GHC/Core/Op/DmdAnal.hs
=====================================
@@ -27,7 +27,6 @@ import Data.List        ( mapAccumL )
 import GHC.Core.DataCon
 import Id
 import IdInfo
-import TysWiredIn
 import GHC.Core.Utils
 import GHC.Core.TyCon
 import GHC.Core.Type
@@ -351,24 +350,19 @@ forcesRealWorld :: FamInstEnvs -> Type -> Bool
 forcesRealWorld fam_envs = go initRecTc
   where
     go :: RecTcChecker -> Type -> Bool
-    go _rec_tc ty
-      | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty
-      , dc == tupleDataCon Unboxed 2
-      , ((first_ty,_):_) <- field_tys
-      , first_ty `eqType` realWorldStatePrimTy
+    go rec_tc ty
+      -- Found it!
+      | ty `eqType`  realWorldStatePrimTy
       = True
-      -- -- Found it!
-      -- | ty `eqType`  realWorldStatePrimTy
-      -- = True
-      -- -- search depth-first
-      -- | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty
-      -- -- don't check the same TyCon twice
-      -- , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc)
-      -- = any (strict_field_forces rec_tc') field_tys
+      -- search depth-first
+      | Just (dc, _, field_tys, _) <- deepSplitProductType_maybe fam_envs ty
+      -- don't check the same TyCon twice
+      , Just rec_tc' <- checkRecTc rec_tc (dataConTyCon dc)
+      = any (strict_field_forces rec_tc') field_tys
       | otherwise
       = False
 
-    _strict_field_forces rec_tc (field_ty, str_mark) =
+    strict_field_forces rec_tc (field_ty, str_mark) =
       (isMarkedStrict str_mark || isLiftedType_maybe field_ty == Just False)
         && go rec_tc field_ty
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ebfdf4fb3f0e1c020b166f11864b30cf7587d28
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200329/e93cc635/attachment-0001.html>