Implement a capi calling convention; fixes #2979

In GHC, this provides an easy way to call a C function via a C wrapper.
This is important when the function is really defined by CPP.

Requires the new CApiFFI extension.

Not documented yet, as it's still an experimental feature at this stage.

1 files changed, 9 insertions, 2 deletions

diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 458e7c6747..f959fb08d4 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -151,13 +151,15 @@ platforms.
 See: http://www.programmersheaven.com/2/Calling-conventions
 
 \begin{code}
-data CCallConv = CCallConv | StdCallConv | CmmCallConv | PrimCallConv
+data CCallConv = CCallConv | CApiConv | StdCallConv
+               | CmmCallConv | PrimCallConv
   deriving (Eq, Data, Typeable)
   {-! derive: Binary !-}
 
 instance Outputable CCallConv where
   ppr StdCallConv = ptext (sLit "stdcall")
   ppr CCallConv   = ptext (sLit "ccall")
+  ppr CApiConv    = ptext (sLit "capi")
   ppr CmmCallConv = ptext (sLit "C--")
   ppr PrimCallConv = ptext (sLit "prim")
 
@@ -167,6 +169,7 @@ defaultCCallConv = CCallConv
 ccallConvToInt :: CCallConv -> Int
 ccallConvToInt StdCallConv = 0
 ccallConvToInt CCallConv   = 1
+ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"
 ccallConvToInt (CmmCallConv {})  = panic "ccallConvToInt CmmCallConv"
 ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"
 \end{code}
@@ -178,6 +181,7 @@ calling convention (used by PprAbsC):
 ccallConvAttribute :: CCallConv -> SDoc
 ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"
 ccallConvAttribute CCallConv         = empty
+ccallConvAttribute CApiConv          = empty
 ccallConvAttribute (CmmCallConv {})  = panic "ccallConvAttribute CmmCallConv"
 ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"
 \end{code}
@@ -294,11 +298,14 @@ instance Binary CCallConv where
             putByte bh 2
     put_ bh CmmCallConv = do
             putByte bh 3
+    put_ bh CApiConv = do
+            putByte bh 4
     get bh = do
             h <- getByte bh
             case h of
               0 -> do return CCallConv
               1 -> do return StdCallConv
               2 -> do return PrimCallConv
-              _ -> do return CmmCallConv
+              3 -> do return CmmCallConv
+              _ -> do return CApiConv
 \end{code}