commit f70ff9094bb89d2711ddccd92251dcfa74f86002
Author: Joachim Breitner <mail@joachim-breitner.de>
Date:   Sun Jan 26 11:36:23 2014 +0000

    Add GHC.Prim.oneShot

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 604163f..c6fcbae 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -141,7 +141,8 @@ ghcPrimIds
     seqId,
     magicDictId,
     coerceId,
-    proxyHashId
+    proxyHashId,
+    oneShotId
     ]
 \end{code}
 
@@ -1040,7 +1041,7 @@ another gun with which to shoot yourself in the foot.
 \begin{code}
 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    realWorldName, voidPrimIdName, coercionTokenName,
-   magicDictName, coerceName, proxyName :: Name
+   magicDictName, coerceName, proxyName, 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
@@ -1051,6 +1052,7 @@ coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTo
 magicDictName     = mkWiredInIdName gHC_PRIM (fsLit "magicDict")     magicDictKey magicDictId
 coerceName        = mkWiredInIdName gHC_PRIM (fsLit "coerce")        coerceKey          coerceId
 proxyName         = mkWiredInIdName gHC_PRIM (fsLit "proxy#")        proxyHashKey       proxyHashId
+oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")       oneShotKey         oneShotId
 \end{code}
 
 \begin{code}
@@ -1131,6 +1133,17 @@ lazyId = pcMiscPrelId lazyIdName ty info
     info = noCafIdInfo
     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
 
+oneShotId :: Id
+oneShotId = pcMiscPrelId oneShotName ty info
+  where
+    info = noCafIdInfo `setInlinePragInfo` (alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter 0)
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+    ty  = mkForAllTys [alphaTyVar, betaTyVar] (mkFunTy fun_ty fun_ty)
+    fun_ty = mkFunTy alphaTy betaTy
+    [body, x] = mkTemplateLocals [fun_ty, alphaTy]
+    x' = setOneShotLambda x
+    rhs = mkLams [alphaTyVar, betaTyVar, body, x'] $ Var body `App` Var x
+
 
 --------------------------------------------------------------------------------
 magicDictId :: Id  -- See Note [magicDictId magic]
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 3f00c62..524912e 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1684,10 +1684,11 @@ rootMainKey, runMainKey :: Unique
 rootMainKey                   = mkPreludeMiscIdUnique 101
 runMainKey                    = mkPreludeMiscIdUnique 102
 
-thenIOIdKey, lazyIdKey, assertErrorIdKey :: Unique
+thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey :: Unique
 thenIOIdKey                   = mkPreludeMiscIdUnique 103
 lazyIdKey                     = mkPreludeMiscIdUnique 104
 assertErrorIdKey              = mkPreludeMiscIdUnique 105
+oneShotKey                    = mkPreludeMiscIdUnique 106
 
 breakpointIdKey, breakpointCondIdKey, breakpointAutoIdKey,
     breakpointJumpIdKey, breakpointCondJumpIdKey,