Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4b9be1dbea0cfbe457635fd7ec20022b25ba0dd9 >--------------------------------------------------------------- commit 4b9be1dbea0cfbe457635fd7ec20022b25ba0dd9 Author: Ian Lynagh <[email protected]> Date: Sat Nov 26 18:00:58 2011 +0000 Small refactoring >--------------------------------------------------------------- compiler/cmm/PprC.hs | 2 +- compiler/deSugar/DsForeign.lhs | 5 +---- compiler/prelude/ForeignCall.lhs | 6 +++--- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index a2ffd18..fc97be2 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -254,7 +254,7 @@ pprStmt platform stmt = case stmt of pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc pprCFunType ppr_fn cconv ress args = res_type ress <+> - parens (text (ccallConvAttribute cconv) <> ppr_fn) <> + parens (ccallConvAttribute cconv <> ppr_fn) <> parens (commafy (map arg_type args)) where res_type [] = ptext (sLit "void") diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 318d1df..75c2dc4 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -509,10 +509,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc int64TyConKey, word64TyConKey] -- Now we can cook up the prototype for the exported function. - pprCconv = case cc of - CCallConv -> empty - StdCallConv -> text (ccallConvAttribute cc) - _ -> panic ("mkFExportCBits/pprCconv " ++ showPpr cc) + pprCconv = ccallConvAttribute cc header_bits = ptext (sLit "extern") <+> fun_proto <> semi diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs index 5e0f9ec..458e7c6 100644 --- a/compiler/prelude/ForeignCall.lhs +++ b/compiler/prelude/ForeignCall.lhs @@ -175,9 +175,9 @@ Generate the gcc attribute corresponding to the given calling convention (used by PprAbsC): \begin{code} -ccallConvAttribute :: CCallConv -> String -ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))" -ccallConvAttribute CCallConv = "" +ccallConvAttribute :: CCallConv -> SDoc +ccallConvAttribute StdCallConv = text "__attribute__((__stdcall__))" +ccallConvAttribute CCallConv = empty ccallConvAttribute (CmmCallConv {}) = panic "ccallConvAttribute CmmCallConv" ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv" \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
