summaryrefslogtreecommitdiff
path: root/compiler/deSugar/DsForeign.lhs
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2008-04-02 05:14:12 +0000
committerSimon Marlow <simonmar@microsoft.com>2008-04-02 05:14:12 +0000
commitc245355e6f2c7b7c95e9af910c4d420e13af9413 (patch)
treee8309f467b8bea2501e9f7de7af86fbfc22e0a67 /compiler/deSugar/DsForeign.lhs
parentab5c770bed51f08d56a0d61086988053b21aa461 (diff)
downloadhaskell-c245355e6f2c7b7c95e9af910c4d420e13af9413.tar.gz
Do not #include external header files when compiling via C
This has several advantages: - -fvia-C is consistent with -fasm with respect to FFI declarations: both bind to the ABI, not the API. - foreign calls can now be inlined freely across module boundaries, since a header file is not required when compiling the call. - bootstrapping via C will be more reliable, because this difference in behavour between the two backends has been removed. There is one disadvantage: - we get no checking by the C compiler that the FFI declaration is correct. So now, the c-includes field in a .cabal file is always ignored by GHC, as are header files specified in an FFI declaration. This was previously the case only for -fasm compilations, now it is also the case for -fvia-C too.
Diffstat (limited to 'compiler/deSugar/DsForeign.lhs')
-rw-r--r--compiler/deSugar/DsForeign.lhs55
1 files changed, 17 insertions, 38 deletions
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 9ad1d48791..1b269fab1f 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -76,27 +76,26 @@ dsForeigns []
dsForeigns fos = do
fives <- mapM do_ldecl fos
let
- (hs, cs, hdrs, idss, bindss) = unzip5 fives
+ (hs, cs, idss, bindss) = unzip4 fives
fe_ids = concat idss
fe_init_code = map foreignExportInitialiser fe_ids
--
return (ForeignStubs
(vcat hs)
- (vcat cs $$ vcat fe_init_code)
- (nub (concat hdrs)),
+ (vcat cs $$ vcat fe_init_code),
(concat bindss))
where
do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
do_decl (ForeignImport id _ spec) = do
traceIf (text "fi start" <+> ppr id)
- (bs, h, c, mbhd) <- dsFImport (unLoc id) spec
+ (bs, h, c) <- dsFImport (unLoc id) spec
traceIf (text "fi end" <+> ppr id)
- return (h, c, maybeToList mbhd, [], bs)
+ return (h, c, [], bs)
do_decl (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv))) = do
(h, c, _, _) <- dsFExport id (idType id) ext_nm cconv False
- return (h, c, [], [id], [])
+ return (h, c, [id], [])
\end{code}
@@ -127,51 +126,32 @@ because it exposes the boxing to the call site.
\begin{code}
dsFImport :: Id
-> ForeignImport
- -> DsM ([Binding], SDoc, SDoc, Maybe FastString)
+ -> DsM ([Binding], SDoc, SDoc)
dsFImport id (CImport cconv safety header lib spec) = do
- (ids, h, c) <- dsCImport id spec cconv safety no_hdrs
- return (ids, h, c, if no_hdrs then Nothing else Just header)
- where
- no_hdrs = nullFS header
+ (ids, h, c) <- dsCImport id spec cconv safety
+ return (ids, h, c)
-- FIXME: the `lib' field is needed for .NET ILX generation when invoking
-- routines that are external to the .NET runtime, but GHC doesn't
-- support such calls yet; if `nullFastString lib', the value was not given
dsFImport id (DNImport spec) = do
- (ids, h, c) <- dsFCall id (DNCall spec) True {- No headers -}
- return (ids, h, c, Nothing)
+ (ids, h, c) <- dsFCall id (DNCall spec)
+ return (ids, h, c)
dsCImport :: Id
-> CImportSpec
-> CCallConv
-> Safety
- -> Bool -- True <=> no headers in the f.i decl
-> DsM ([Binding], SDoc, SDoc)
-dsCImport id (CLabel cid) _ _ no_hdrs = do
+dsCImport id (CLabel cid) _ _ = do
(resTy, foRhs) <- resultWrapper (idType id)
ASSERT(fromJust resTy `coreEqType` addrPrimTy) -- typechecker ensures this
let rhs = foRhs (mkLit (MachLabel cid Nothing)) in
- return ([(setImpInline no_hdrs id, rhs)], empty, empty)
-dsCImport id (CFunction target) cconv safety no_hdrs
- = dsFCall id (CCall (CCallSpec target cconv safety)) no_hdrs
-dsCImport id CWrapper cconv _ _
+ return ([(id, rhs)], empty, empty)
+dsCImport id (CFunction target) cconv safety
+ = dsFCall id (CCall (CCallSpec target cconv safety))
+dsCImport id CWrapper cconv _
= dsFExportDynamic id cconv
-
-setImpInline :: Bool -- True <=> No #include headers
- -- in the foreign import declaration
- -> Id -> Id
--- If there is a #include header in the foreign import
--- we make the worker non-inlinable, because we currently
--- don't keep the #include stuff in the CCallId, and hence
--- it won't be visible in the importing module, which can be
--- fatal.
--- (The #include stuff is just collected from the foreign import
--- decls in a module.)
--- If you want to do cross-module inlining of the c-calls themselves,
--- put the #include stuff in the package spec, not the foreign
--- import decl.
-setImpInline True id = id
-setImpInline False id = id `setInlinePragma` NeverActive
\end{code}
@@ -182,7 +162,7 @@ setImpInline False id = id `setInlinePragma` NeverActive
%************************************************************************
\begin{code}
-dsFCall fn_id fcall no_hdrs = do
+dsFCall fn_id fcall = do
let
ty = idType fn_id
(tvs, fun_ty) = tcSplitForAllTys ty
@@ -229,8 +209,7 @@ dsFCall fn_id fcall no_hdrs = do
worker_ty = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
the_ccall_app = mkFCall ccall_uniq fcall val_args ccall_result_ty
work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app)
- work_id = setImpInline no_hdrs $ -- See comments with setImpInline
- mkSysLocal FSLIT("$wccall") work_uniq worker_ty
+ work_id = mkSysLocal FSLIT("$wccall") work_uniq worker_ty
-- Build the wrapper
work_app = mkApps (mkVarApps (Var work_id) tvs) val_args