Desugaring for "foreign import prim"

Unlike normal foreign imports which desugar into a separate worker and
wrapper, we use just a single wrapper decleration. The representation
in Core of the call is currently as a foreign call. This means the
args are all treated as fully strict. This is ok at the moment because
we restrict the types for foreign import prim to be of unboxed types,
however in future we may want to make prim imports be the normal cmm
calling convention for Haskell functions, in which case we would not
be able to assume all args are strict. At that point it may make more
sense to represent cmm/prim calls distinct from foreign calls, and
more like the we the existing PrimOp calls are handled.

diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 7071ab7..9dea2ad 100644 (file)
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -155,6 +155,8 @@ dsCImport id (CLabel cid) cconv _ = do
     in
     return ([(id, rhs)], empty, empty)
 
     in
     return ([(id, rhs)], empty, empty)
 

+dsCImport id (CFunction target) cconv@PrimCallConv safety
+  = dsPrimCall id (CCall (CCallSpec target cconv safety))

 dsCImport id (CFunction target) cconv safety
   = dsFCall id (CCall (CCallSpec target cconv safety))
 dsCImport id CWrapper cconv _
 dsCImport id (CFunction target) cconv safety
   = dsFCall id (CCall (CCallSpec target cconv safety))
 dsCImport id CWrapper cconv _

@@ -243,6 +245,39 @@ dsFCall fn_id fcall = do
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

+\subsection{Primitive calls}
+%*                                                                     *
+%************************************************************************
+
+This is for `@foreign import prim@' declarations.
+
+Currently, at the core level we pretend that these primitive calls are
+foreign calls. It may make more sense in future to have them as a distinct
+kind of Id, or perhaps to bundle them with PrimOps since semantically and
+for calling convention they are really prim ops.
+
+\begin{code}
+dsPrimCall :: Id -> ForeignCall -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
+dsPrimCall fn_id fcall = do
+    let
+        ty                   = idType fn_id
+        (tvs, fun_ty)        = tcSplitForAllTys ty
+        (arg_tys, io_res_ty) = tcSplitFunTys fun_ty
+                -- Must use tcSplit* functions because we want to
+                -- see that (IO t) in the corner
+
+    args <- newSysLocalsDs arg_tys
+
+    ccall_uniq <- newUnique
+    let
+        call_app = mkFCall ccall_uniq fcall (map Var args) io_res_ty
+        rhs      = mkLams tvs (mkLams args call_app)
+    return ([(fn_id, rhs)], empty, empty)
+
+\end{code}
+
+%************************************************************************
+%*                                                                     *

 \subsection{Foreign export}
 %*                                                                     *
 %************************************************************************
 \subsection{Foreign export}
 %*                                                                     *
 %************************************************************************

@@ -487,7 +522,7 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
   pprCconv = case cc of
                CCallConv   -> empty
                StdCallConv -> text (ccallConvAttribute cc)
   pprCconv = case cc of
                CCallConv   -> empty
                StdCallConv -> text (ccallConvAttribute cc)

-                CmmCallConv -> panic "mkFExportCBits/pprCconv CmmCallConv"
+                _           -> panic ("mkFExportCBits/pprCconv " ++ showPpr cc)

 
   header_bits = ptext (sLit "extern") <+> fun_proto <> semi
 
 
   header_bits = ptext (sLit "extern") <+> fun_proto <> semi