diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 63b65398eb6472bb03d98a530cd1473bb12173c7..6eeba5eb18e898b0f161d69c04cdd3aa4f937cdc 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -491,12 +491,14 @@ repForD (L loc (ForeignImport name typ _ (CImport (L _ cc) (L _ s) mch cis _))) conv_cimportspec (CFunction (StaticTarget fs _ True)) = return (unpackFS fs) conv_cimportspec (CFunction (StaticTarget _ _ False)) = panic "conv_cimportspec: values not supported yet" conv_cimportspec CWrapper = return "wrapper" + -- these calling conventions do not support headers and the static keyword + raw_cconv = cc == PrimCallConv || cc == JavaScriptCallConv static = case cis of - CFunction (StaticTarget _ _ _) -> "static " + CFunction (StaticTarget _ _ _) | not raw_cconv -> "static " _ -> "" chStr = case mch of - Nothing -> "" - Just (Header h) -> unpackFS h ++ " " + Just (Header h) | not raw_cconv -> unpackFS h ++ " " + _ -> "" repForD decl = notHandled "Foreign declaration" (ppr decl) repCCallConv :: CCallConv -> DsM (Core TH.Callconv) diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index 03c9bf5024b002df6d44cbebad28d2c51e087bfa..8ffda3a91e664ffe91be2f8a04407ca00e7f9877 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -476,16 +476,22 @@ noExistentials = [] cvtForD :: Foreign -> CvtM (ForeignDecl RdrName) cvtForD (ImportF callconv safety from nm ty) + | callconv == TH.Prim || callconv == TH.JavaScript + = mk_imp (CImport (noLoc (cvt_conv callconv)) (noLoc safety') Nothing + (CFunction (StaticTarget (mkFastString from) Nothing True)) + (noLoc from)) | Just impspec <- parseCImport (noLoc (cvt_conv callconv)) (noLoc safety') (mkFastString (TH.nameBase nm)) from (noLoc from) - = do { nm' <- vNameL nm - ; ty' <- cvtType ty - ; return (ForeignImport nm' ty' noForeignImportCoercionYet impspec) - } + = mk_imp impspec | otherwise = failWith $ text (show from) <+> ptext (sLit "is not a valid ccall impent") where + mk_imp impspec + = do { nm' <- vNameL nm + ; ty' <- cvtType ty + ; return (ForeignImport nm' ty' noForeignImportCoercionYet impspec) + } safety' = case safety of Unsafe -> PlayRisky Safe -> PlaySafe