[commit: ghc] wip/oneShot: Add GHC.Prim.oneShot (f653aab)

[git at git.haskell.org]

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

On branch  : wip/oneShot
Link       : http://ghc.haskell.org/trac/ghc/changeset/f653aab99d56a9f0931075b0c684bb07c1b25f08/ghc

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

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

    Add GHC.Prim.oneShot
    
    Conflicts:
    	compiler/basicTypes/MkId.lhs


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

f653aab99d56a9f0931075b0c684bb07c1b25f08
 compiler/basicTypes/MkId.lhs   | 17 +++++++++++++++--
 compiler/prelude/PrelNames.lhs |  3 ++-
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index bf1c199..05dcdd5 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -135,7 +135,8 @@ ghcPrimIds
     seqId,
     magicDictId,
     coerceId,
-    proxyHashId
+    proxyHashId,
+    oneShotId
     ]
 \end{code}
 
@@ -1016,7 +1017,7 @@ another gun with which to shoot yourself in the foot.
 \begin{code}
 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    realWorldName, voidPrimIdName, coercionTokenName,
-   magicDictName, coerceName, proxyName, dollarName :: Name
+   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
@@ -1028,6 +1029,7 @@ magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDict
 coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId
 proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
 dollarName        = mkWiredInIdName gHC_BASE  (fsLit "$")              dollarIdKey        dollarId
+oneShotName       = mkWiredInIdName gHC_PRIM (fsLit "oneShot")       oneShotKey         oneShotId
 \end{code}
 
 \begin{code}
@@ -1119,6 +1121,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
+                       `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 4e98739..73d1cf3 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1686,10 +1686,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,