projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Print better error message for reading External Core
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsForeign.lhs
diff --git
a/compiler/deSugar/DsForeign.lhs
b/compiler/deSugar/DsForeign.lhs
index
d7096ae
..
9ad1d48
100644
(file)
--- a/
compiler/deSugar/DsForeign.lhs
+++ b/
compiler/deSugar/DsForeign.lhs
@@
-483,14
+483,17
@@
mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
header_bits = ptext SLIT("extern") <+> fun_proto <> semi
header_bits = ptext SLIT("extern") <+> fun_proto <> semi
+ fun_args
+ | null aug_arg_info = text "void"
+ | otherwise = hsep $ punctuate comma
+ $ map (\(nm,ty,_,_) -> ty <+> nm) aug_arg_info
+
fun_proto
| libffi
= ptext SLIT("void") <+> ftext c_nm <>
parens (ptext SLIT("void *cif STG_UNUSED, void* resp, void** args, void* the_stableptr"))
| otherwise
fun_proto
| libffi
= ptext SLIT("void") <+> ftext c_nm <>
parens (ptext SLIT("void *cif STG_UNUSED, void* resp, void** args, void* the_stableptr"))
| otherwise
- = cResType <+> pprCconv <+> ftext c_nm <>
- parens (hsep (punctuate comma (map (\(nm,ty,_,_) -> ty <+> nm)
- aug_arg_info)))
+ = cResType <+> pprCconv <+> ftext c_nm <> parens fun_args
-- the target which will form the root of what we ask rts_evalIO to run
the_cfun
-- the target which will form the root of what we ask rts_evalIO to run
the_cfun
@@
-656,7
+659,7
@@
primTyDescChar ty
WordRep -> unsigned_word
Int64Rep -> 'L'
Word64Rep -> 'l'
WordRep -> unsigned_word
Int64Rep -> 'L'
Word64Rep -> 'l'
- AddrRep -> unsigned_word
+ AddrRep -> 'p'
FloatRep -> 'f'
DoubleRep -> 'd'
_ -> pprPanic "primTyDescChar" (ppr ty)
FloatRep -> 'f'
DoubleRep -> 'd'
_ -> pprPanic "primTyDescChar" (ppr ty)