Introduce GHC.Base.noupdate as an alternative to {-# NOUPDATE #-} unshare
authorJoachim Breitner <mail@joachim-breitner.de>
Thu, 30 Aug 2012 08:19:10 +0000 (10:19 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Thu, 30 Aug 2012 08:19:10 +0000 (10:19 +0200)
compiler/basicTypes/MkId.lhs
compiler/prelude/PrelNames.lhs
compiler/prelude/PrelRules.lhs
compiler/prelude/primops.txt.pp

index 7bb5d16..0ef6ee1 100644 (file)
@@ -32,7 +32,7 @@ module MkId (
         -- And some particular Ids; see below for why they are wired in
         wiredInIds, ghcPrimIds,
         unsafeCoerceName, unsafeCoerceId, realWorldPrimId, 
-        voidArgId, nullAddrId, seqId, lazyId, lazyIdKey,
+        voidArgId, nullAddrId, seqId, lazyId, lazyIdKey, noupdateIdKey,
         coercionTokenId,
 
        -- Re-export error Ids
@@ -130,7 +130,8 @@ ghcPrimIds
     realWorldPrimId,
     unsafeCoerceId,
     nullAddrId,
-    seqId
+    seqId,
+    noupdateId -- Here for now to avoid changing base
     ]
 \end{code}
 
@@ -876,13 +877,14 @@ they can unify with both unlifted and lifted types.  Hence we provide
 another gun with which to shoot yourself in the foot.
 
 \begin{code}
-lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName :: Name
+lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName, noupdateName :: 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
 realWorldName     = mkWiredInIdName gHC_PRIM (fsLit "realWorld#")    realWorldPrimIdKey realWorldPrimId
 lazyIdName        = mkWiredInIdName gHC_BASE (fsLit "lazy")         lazyIdKey           lazyId
 coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
+noupdateName      = mkWiredInIdName gHC_PRIM (fsLit "noupdate")      noupdateIdKey noupdateId
 \end{code}
 
 \begin{code}
@@ -948,6 +950,12 @@ lazyId = pcMiscPrelId lazyIdName ty info
   where
     info = noCafIdInfo
     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
+
+noupdateId :: Id
+noupdateId = pcMiscPrelId noupdateName ty info
+  where
+    info = noCafIdInfo
+    ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
 \end{code}
 
 Note [Unsafe coerce magic]
index 3174974..e1dc0c8 100644 (file)
@@ -245,7 +245,7 @@ basicKnownKeyNames
         wordTyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName,
 
         -- Others
-        otherwiseIdName, inlineIdName,
+        otherwiseIdName, inlineIdName, noupdateIdName,
         eqStringName, assertName, breakpointName, breakpointCondName,
         breakpointAutoName,  opaqueTyConName,
         assertErrorName, runSTRepName,
@@ -770,6 +770,10 @@ stringTyConName         = tcQual  gHC_BASE (fsLit "String") stringTyConKey
 inlineIdName :: Name
 inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
 
+-- The 'noupdate' function
+noupdateIdName :: Name
+noupdateIdName          = varQual gHC_MAGIC (fsLit "noupdate") noupdateIdKey
+
 -- The 'undefined' function. Used by supercompilation.
 undefinedName :: Name
 undefinedName = varQual gHC_ERR (fsLit "undefined") undefinedKey
@@ -1626,6 +1630,8 @@ checkDotnetResNameIdKey       = mkPreludeMiscIdUnique 154
 undefinedKey :: Unique
 undefinedKey                  = mkPreludeMiscIdUnique 155
 
+noupdateIdKey :: Unique
+noupdateIdKey                 = mkPreludeMiscIdUnique 156
 \end{code}
 
 Certain class operations from Prelude classes.  They get their own
index b5b350b..951fcbc 100644 (file)
@@ -720,7 +720,9 @@ builtinRules
      BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName,
                    ru_nargs = 2, ru_try = \_ -> match_eq_string },
      BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName,
-                   ru_nargs = 2, ru_try = \_ -> match_inline }]
+                   ru_nargs = 2, ru_try = \_ -> match_inline },
+     BuiltinRule { ru_name = fsLit "Noupdate", ru_fn = noupdateIdName,
+                   ru_nargs = 2, ru_try = \_ -> match_noupdate }]
  ++ builtinIntegerRules
 
 builtinIntegerRules :: [CoreRule]
@@ -883,6 +885,10 @@ match_inline _ (Type _ : e : _)
 
 match_inline _ _ = Nothing
 
+match_noupdate :: IdUnfoldingFun -> [Expr CoreBndr] -> Maybe (Expr CoreBndr)
+match_noupdate _ (Type _ : e : _) = Just (Tick DontUpdate e)
+match_noupdate _ _ = Nothing
+
 -------------------------------------------------
 -- Integer rules
 --   smallInteger  (79::Int#)  = 79::Integer   
index cddb62a..83d1e68 100644 (file)
@@ -2090,6 +2090,9 @@ pseudoop   "inline"
         its definition, (a) so that GHC guarantees to expose its unfolding regardless
         of size, and (b) so that you have control over exactly what is inlined. }
 
+pseudoop   "noupdate"
+   a -> a
+
 pseudoop   "lazy"
    a -> a
    { The {\tt lazy} function restrains strictness analysis a little. The call