[commit: ghc] wip/T9732: Avoid premature unfolding of `seq`, and provide a source-level binding in GHC.Magic for cases when it slips through (1804be5)

[git at git.haskell.org]

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

On branch  : wip/T9732
Link       : http://ghc.haskell.org/trac/ghc/changeset/1804be5f22de4b08b25efc8d8544f4d1110816b6/ghc

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

commit 1804be5f22de4b08b25efc8d8544f4d1110816b6
Author: Dr. ERDI Gergo <gergo at erdi.hu>
Date:   Thu Nov 13 17:39:03 2014 +0800

    Avoid premature unfolding of `seq`, and provide a source-level binding
    in GHC.Magic for cases when it slips through


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

1804be5f22de4b08b25efc8d8544f4d1110816b6
 compiler/basicTypes/MkId.lhs         |  9 ++++-----
 libraries/base/GHC/Event/IntTable.hs |  2 +-
 libraries/base/GHC/Exts.hs           |  2 +-
 libraries/ghc-prim/GHC/Magic.hs      | 12 +++++++++++-
 4 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index b32a2b7..8f97d49 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -119,7 +119,7 @@ is right here.
 \begin{code}
 wiredInIds :: [Id]
 wiredInIds
-  =  [lazyId, dollarId, oneShotId]
+  =  [lazyId, dollarId, oneShotId, seqId]
   ++ errorIds           -- Defined in MkCore
   ++ ghcPrimIds
 
@@ -132,7 +132,6 @@ ghcPrimIds
     voidPrimId,
     unsafeCoerceId,
     nullAddrId,
-    seqId,
     magicDictId,
     coerceId,
     proxyHashId
@@ -1019,7 +1018,7 @@ lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    magicDictName, coerceName, proxyName, dollarName, oneShotName :: Name
 unsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit "unsafeCoerce#")  unsafeCoerceIdKey  unsafeCoerceId
 nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId
-seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId
+seqName           = mkWiredInIdName gHC_MAGIC (fsLit "seq")            seqIdKey           seqId
 realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId
 voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId
 lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId
@@ -1088,7 +1087,7 @@ seqId :: Id     -- See Note [seqId magic]
 seqId = pcMiscPrelId seqName ty info
   where
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
-                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+                       `setUnfoldingInfo`  mkInlineUnfolding (Just 2) rhs
                        `setSpecInfo`       mkSpecInfo [seq_cast_rule]
 
 
@@ -1097,7 +1096,7 @@ seqId = pcMiscPrelId seqName ty info
               -- NB argBetaTyVar; see Note [seqId magic]
 
     [x,y] = mkTemplateLocals [alphaTy, betaTy]
-    rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
+    rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
 
     -- See Note [Built-in RULES for seq]
     seq_cast_rule = BuiltinRule { ru_name  = fsLit "seq of cast"
diff --git a/libraries/base/GHC/Event/IntTable.hs b/libraries/base/GHC/Event/IntTable.hs
index cb76319..dc4485f 100644
--- a/libraries/base/GHC/Event/IntTable.hs
+++ b/libraries/base/GHC/Event/IntTable.hs
@@ -21,7 +21,7 @@ import GHC.Base (Monad(..), (=<<), ($), const, liftM, otherwise, when)
 import GHC.Classes (Eq(..), Ord(..))
 import GHC.Event.Arr (Arr)
 import GHC.Num (Num(..))
-import GHC.Prim (seq)
+import GHC.Magic (seq)
 import GHC.Types (Bool(..), IO(..), Int(..))
 import qualified GHC.Event.Arr as Arr
 
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 6754edc..c536021 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -44,7 +44,7 @@ module GHC.Exts
         breakpoint, breakpointCond,
 
         -- * Ids with special behaviour
-        lazy, inline,
+        lazy, inline, seq,
 
         -- * Safe coercions
         --
diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs
index 1a6af92..37d0cb2 100644
--- a/libraries/ghc-prim/GHC/Magic.hs
+++ b/libraries/ghc-prim/GHC/Magic.hs
@@ -17,7 +17,9 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.Magic ( inline, lazy, oneShot ) where
+module GHC.Magic ( inline, lazy, oneShot, seq ) where
+
+infixr 0 `seq`
 
 -- | The call @inline f@ arranges that 'f' is inlined, regardless of
 -- its size. More precisely, the call @inline f@ rewrites to the
@@ -73,3 +75,11 @@ oneShot :: (a -> b) -> (a -> b)
 oneShot f = f
 -- Implementation note: This is wired in in MkId.lhs, so the code here is
 -- mostly there to have a place for the documentation.
+
+-- | The 'seq' function forces evaluation of its first argument to WHNF
+-- and returns its second argument unchanged.
+seq :: a -> b -> b
+seq x y = seq x y
+-- Implementation note: This is wired in in MkId.lhs, so the code here is
+-- mostly there to have a place for the documentation, and to have a fallback
+-- when seq fails to be unfolded in a call