Commit 0632467a authored by sewardj's avatar sewardj

[project @ 2001-08-07 09:16:15 by sewardj]

This buffer is for notes you don't want to save, and for Lisp evaluation.
If you want to create a file, visit that file with C-x C-f,
then enter the text in that file's own buffer.

Interpreter FFI improvements:

* Support f-i dynamic.
* Correctly handle fns which don't return anything.
* Support x86 stdcall call-conv.

Clean-up of FFI-related code in ByteCodeGen.lhs.
parent 2b8f3628
...@@ -10,6 +10,7 @@ module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) where ...@@ -10,6 +10,7 @@ module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) where
import Outputable import Outputable
import PrimRep ( PrimRep(..), getPrimRepSize, isFollowableRep ) import PrimRep ( PrimRep(..), getPrimRepSize, isFollowableRep )
import ForeignCall ( CCallConv(..) )
import Bits ( Bits(..), shiftR ) import Bits ( Bits(..), shiftR )
import Word ( Word8, Word32 ) import Word ( Word8, Word32 )
import Addr ( Addr(..), writeWord8OffAddr ) import Addr ( Addr(..), writeWord8OffAddr )
...@@ -62,6 +63,9 @@ sendBytesToMallocville bytes ...@@ -62,6 +63,9 @@ sendBytesToMallocville bytes
\begin{code} \begin{code}
-- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc.
#include "nativeGen/NCG.h"
{- {-
Make a piece of code which expects to see the Haskell stack Make a piece of code which expects to see the Haskell stack
looking like this. It is given a pointer to the lowest word in looking like this. It is given a pointer to the lowest word in
...@@ -72,18 +76,29 @@ the stack -- presumably the tag of the placeholder. ...@@ -72,18 +76,29 @@ the stack -- presumably the tag of the placeholder.
<arg_1> <arg_1>
Addr# address_of_C_fn Addr# address_of_C_fn
<placeholder-for-result#> (must be an unboxed type) <placeholder-for-result#> (must be an unboxed type)
We cope with both ccall and stdcall for the C fn. However, this code
itself expects only to be called using the ccall convention -- that is,
we don't clear our own (single) arg off the C stack.
-} -}
mkMarshalCode :: (Int, PrimRep) -> Int -> [(Int, PrimRep)] mkMarshalCode :: CCallConv
-> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
-> Addr -> Addr
mkMarshalCode (r_offW, r_rep) addr_offW arg_offs_n_reps mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let bytes = mkMarshalCode_wrk (r_offW, r_rep) = let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep)
addr_offW arg_offs_n_reps addr_offW arg_offs_n_reps
in unsafePerformIO (sendBytesToMallocville bytes) in unsafePerformIO (sendBytesToMallocville bytes)
mkMarshalCode_wrk :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
mkMarshalCode_wrk :: CCallConv
-> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
-> [Word8] -> [Word8]
mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
#if i386_TARGET_ARCH
mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let -- Don't change this without first consulting Intel Corp :-) = let -- Don't change this without first consulting Intel Corp :-)
bytes_per_word = 4 bytes_per_word = 4
...@@ -218,7 +233,9 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps ...@@ -218,7 +233,9 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
addl $4*number_of_args_pushed, %esp (ccall only) addl $4*number_of_args_pushed, %esp (ccall only)
movl 28+4(%esp), %esi movl 28+4(%esp), %esi
-} -}
++ add_lit_esp (bytes_per_word * length offsets_to_pushW) ++ (if cconv /= StdCallConv
then add_lit_esp (bytes_per_word * length offsets_to_pushW)
else [])
++ movl_offespmem_esi 32 ++ movl_offespmem_esi 32
{- Depending on what the return type is, get the result {- Depending on what the return type is, get the result
...@@ -239,6 +256,7 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps ...@@ -239,6 +256,7 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
AddrRep -> movl_eax_offesimem 4 AddrRep -> movl_eax_offesimem 4
DoubleRep -> fstl_offesimem 4 DoubleRep -> fstl_offesimem 4
FloatRep -> fsts_offesimem 4 FloatRep -> fsts_offesimem 4
VoidRep -> []
other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(x86)" (ppr r_rep) other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(x86)" (ppr r_rep)
{- Restore all the pushed regs and go home. {- Restore all the pushed regs and go home.
...@@ -256,5 +274,8 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps ...@@ -256,5 +274,8 @@ mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
++ restore_regs ++ restore_regs
++ ret ++ ret
) )
#endif /* i386_TARGET_ARCH */
\end{code} \end{code}
...@@ -25,6 +25,7 @@ import PprCore ( pprCoreExpr ) ...@@ -25,6 +25,7 @@ import PprCore ( pprCoreExpr )
import Literal ( Literal(..), literalPrimRep ) import Literal ( Literal(..), literalPrimRep )
import PrimRep ( PrimRep(..) ) import PrimRep ( PrimRep(..) )
import PrimOp ( PrimOp(..) ) import PrimOp ( PrimOp(..) )
import CStrings ( CLabelString )
import CoreFVs ( freeVars ) import CoreFVs ( freeVars )
import Type ( typePrimRep, splitTyConApp_maybe, isTyVarTy, splitForAllTys ) import Type ( typePrimRep, splitTyConApp_maybe, isTyVarTy, splitForAllTys )
import DataCon ( dataConTag, fIRST_TAG, dataConTyCon, import DataCon ( dataConTag, fIRST_TAG, dataConTyCon,
...@@ -365,12 +366,22 @@ schemeE d s p (fvs_case, AnnCase (fvs_scrut, scrut) bndr ...@@ -365,12 +366,22 @@ schemeE d s p (fvs_case, AnnCase (fvs_scrut, scrut) bndr
as as
case .... of a -> ... case .... of a -> ...
Use a as the name of the binder too. Use a as the name of the binder too.
Also case .... of (# a #) -> ...
to
case .... of a -> ...
-} -}
schemeE d s p (fvs, AnnCase scrut bndr [(DataAlt dc, [bind1, bind2], rhs)]) schemeE d s p (fvs, AnnCase scrut bndr [(DataAlt dc, [bind1, bind2], rhs)])
| isUnboxedTupleCon dc && VoidRep == typePrimRep (idType bind1) | isUnboxedTupleCon dc && VoidRep == typePrimRep (idType bind1)
= trace "automagic mashing of case alts (# VoidRep, a #)" ( = --trace "automagic mashing of case alts (# VoidRep, a #)" (
schemeE d s p (fvs, AnnCase scrut bind2 [(DEFAULT, [bind2], rhs)]) schemeE d s p (fvs, AnnCase scrut bind2 [(DEFAULT, [bind2], rhs)])
) --)
schemeE d s p (fvs, AnnCase scrut bndr [(DataAlt dc, [bind1], rhs)])
| isUnboxedTupleCon dc
= --trace "automagic mashing of case alts (# a #)" (
schemeE d s p (fvs, AnnCase scrut bind1 [(DEFAULT, [bind1], rhs)])
--)
schemeE d s p (fvs, AnnCase scrut bndr alts) schemeE d s p (fvs, AnnCase scrut bndr alts)
= let = let
...@@ -467,7 +478,8 @@ schemeE d s p other ...@@ -467,7 +478,8 @@ schemeE d s p other
-- --
-- 2. (Another nasty hack). Spot (# a::VoidRep, b #) and treat -- 2. (Another nasty hack). Spot (# a::VoidRep, b #) and treat
-- it simply as b -- since the representations are identical -- it simply as b -- since the representations are identical
-- (the VoidRep takes up zero stack space). -- (the VoidRep takes up zero stack space). Also, spot
-- (# b #) and treat it as b.
-- --
-- 3. Application of a non-nullary constructor, by defn saturated. -- 3. Application of a non-nullary constructor, by defn saturated.
-- Split the args into ptrs and non-ptrs, and push the nonptrs, -- Split the args into ptrs and non-ptrs, and push the nonptrs,
...@@ -508,11 +520,14 @@ schemeT d s p app ...@@ -508,11 +520,14 @@ schemeT d s p app
| let isVoidRepAtom (_, AnnVar v) = VoidRep == typePrimRep (idType v) | let isVoidRepAtom (_, AnnVar v) = VoidRep == typePrimRep (idType v)
isVoidRepAtom (_, AnnNote n e) = isVoidRepAtom e isVoidRepAtom (_, AnnNote n e) = isVoidRepAtom e
in is_con_call && isUnboxedTupleCon con in is_con_call && isUnboxedTupleCon con
&& length args_r_to_l == 2 && ( (length args_r_to_l == 2 && isVoidRepAtom (last (args_r_to_l)))
&& isVoidRepAtom (last (args_r_to_l)) || (length args_r_to_l == 1)
= trace ("schemeT: unboxed pair with Void first component") (
schemeT d s p (head args_r_to_l)
) )
= --trace (if length args_r_to_l == 1
-- then "schemeT: unboxed singleton"
-- else "schemeT: unboxed pair with Void first component") (
schemeT d s p (head args_r_to_l)
--)
-- Cases 3 and 4 -- Cases 3 and 4
| otherwise | otherwise
...@@ -575,11 +590,38 @@ schemeT d s p app ...@@ -575,11 +590,38 @@ schemeT d s p app
do_pushery d [] do_pushery d []
-- CCALL ! -- CCALL !
| Just (CCall (CCallSpec (StaticTarget target) | Just (CCall ccall_spec) <- isFCallId_maybe fn
cconv safety)) <- isFCallId_maybe fn = generateCCall d s fn ccall_spec
| otherwise
= case maybe_dcon of
Just con -> PACK con narg_words `consOL` (
mkSLIDE 1 (d - narg_words - s) `snocOL` ENTER)
Nothing
-> let (push, arg_words) = pushAtom True d p (AnnVar fn)
in push
`appOL` mkSLIDE (narg_words+arg_words)
(d - s - narg_words)
`snocOL` ENTER
{- Given that the args for a CCall have been pushed onto the Haskell
stack, generate the marshalling (machine) code for the ccall, and
create bytecodes to call that and then return in the right way.
-}
generateCCall :: Int -> Sequel -- stack and sequel depths
-> Id -- of target, for type info
-> CCallSpec -- where to call
-> BCInstrList
generateCCall d s fn ccall_spec@(CCallSpec target cconv safety)
= let -- Get the arg and result reps. = let -- Get the arg and result reps.
(a_reps, r_rep) = getCCallPrimReps (idType fn) (a_reps_RAW, maybe_r_rep) = getCCallPrimReps (idType fn)
tys_str = showSDoc (ppr (a_reps, r_rep)) (returns_void, r_rep)
= case maybe_r_rep of
Nothing -> (True, VoidRep)
Just rr -> (False, rr)
{- {-
Because the Haskell stack grows down, the a_reps refer to Because the Haskell stack grows down, the a_reps refer to
lowest to highest addresses in that order. The args for the call lowest to highest addresses in that order. The args for the call
...@@ -616,33 +658,56 @@ schemeT d s p app ...@@ -616,33 +658,56 @@ schemeT d s p app
calls it as a normal C call, assuming it has a signature calls it as a normal C call, assuming it has a signature
void marshall_code ( StgWord* ptr_to_top_of_stack ) void marshall_code ( StgWord* ptr_to_top_of_stack )
-} -}
-- resolve static address -- resolve static address
target_addr (is_static, static_target_addr)
= let unpacked = _UNPK_ target = case target of
DynamicTarget
-> (False, panic "ByteCodeGen.generateCCall(dyn)")
StaticTarget target
-> let unpacked = _UNPK_ target
in case unsafePerformIO (lookupSymbol unpacked) of in case unsafePerformIO (lookupSymbol unpacked) of
Just aa -> case aa of Ptr a# -> A# a# Just aa -> case aa of Ptr a# -> (True, A# a#)
Nothing -> panic ("interpreted ccall: can't resolve: " Nothing -> invalid
++ unpacked) CasmTarget _
-> invalid
where
invalid = pprPanic ("ByteCodeGen.generateCCall: unfindable "
++ "symbol or otherwise invalid target")
(ppr ccall_spec)
-- Get the arg reps, zapping the leading Addr# in the dynamic case
a_reps | is_static = a_reps_RAW
| otherwise = if null a_reps_RAW
then panic "ByteCodeGen.generateCCall: dyn with no args"
else tail a_reps_RAW
-- push the Addr# -- push the Addr#
addr_usizeW = untaggedSizeW AddrRep addr_usizeW = untaggedSizeW AddrRep
addr_tsizeW = taggedSizeW AddrRep addr_tsizeW = taggedSizeW AddrRep
push_Addr = toOL [PUSH_UBX (Right target_addr) addr_usizeW, (push_Addr, d_after_Addr)
PUSH_TAG addr_usizeW] | is_static
d_after_Addr = d + addr_tsizeW = (toOL [PUSH_UBX (Right static_target_addr) addr_usizeW,
-- push the return placeholder PUSH_TAG addr_usizeW],
r_lit = mkDummyLiteral r_rep d + addr_tsizeW)
| otherwise -- is already on the stack
= (nilOL, d)
-- Push the return placeholder. For a call returning nothing,
-- this is a VoidRep (tag).
r_usizeW = untaggedSizeW r_rep r_usizeW = untaggedSizeW r_rep
r_tsizeW = 1{-tag-} + r_usizeW r_tsizeW = taggedSizeW r_rep
push_r = toOL [PUSH_UBX (Left r_lit) r_usizeW,
PUSH_TAG r_usizeW]
d_after_r = d_after_Addr + r_tsizeW d_after_r = d_after_Addr + r_tsizeW
r_lit = mkDummyLiteral r_rep
push_r = (if returns_void
then nilOL
else unitOL (PUSH_UBX (Left r_lit) r_usizeW))
`appOL`
unitOL (PUSH_TAG r_usizeW)
-- do the call -- do the call
do_call = unitOL (CCALL addr_of_marshaller) do_call = unitOL (CCALL addr_of_marshaller)
-- slide and return -- slide and return
wrapup = mkSLIDE r_tsizeW wrapup = mkSLIDE r_tsizeW (d_after_r - r_tsizeW - s)
(d_after_r - r_tsizeW - s)
`snocOL` RETURN r_rep `snocOL` RETURN r_rep
-- generate the marshalling code we're going to call -- generate the marshalling code we're going to call
...@@ -652,32 +717,17 @@ schemeT d s p app ...@@ -652,32 +717,17 @@ schemeT d s p app
args_offW = map (arg1_offW +) args_offW = map (arg1_offW +)
(init (scanl (+) 0 (map taggedSizeW a_reps))) (init (scanl (+) 0 (map taggedSizeW a_reps)))
addr_of_marshaller addr_of_marshaller
= mkMarshalCode (r_offW, r_rep) addr_offW = mkMarshalCode cconv
(r_offW, r_rep) addr_offW
(zip args_offW a_reps) (zip args_offW a_reps)
in in
--trace (show (arg1_offW, args_offW , (map taggedSizeW a_reps) )) ( --trace (show (arg1_offW, args_offW , (map taggedSizeW a_reps) )) (
target_addr push_Addr `appOL` push_r `appOL` do_call `appOL` wrapup
`seq`
(push_Addr `appOL` push_r `appOL` do_call `appOL` wrapup)
--) --)
| otherwise
= case maybe_dcon of
Just con -> PACK con narg_words `consOL` (
mkSLIDE 1 (d - narg_words - s) `snocOL` ENTER)
Nothing
-> let (push, arg_words) = pushAtom True d p (AnnVar fn)
in push
`appOL` mkSLIDE (narg_words+arg_words)
(d - s - narg_words)
`snocOL` ENTER
mkSLIDE n d
= if d == 0 then nilOL else unitOL (SLIDE n d)
bind x f
= f x
-- Make a dummy literal, to be used as a placeholder for FFI return
-- values on the stack.
mkDummyLiteral :: PrimRep -> Literal mkDummyLiteral :: PrimRep -> Literal
mkDummyLiteral pr mkDummyLiteral pr
= case pr of = case pr of
...@@ -692,31 +742,44 @@ mkDummyLiteral pr ...@@ -692,31 +742,44 @@ mkDummyLiteral pr
-- PrelGHC.Int# -> PrelGHC.State# PrelGHC.RealWorld -- PrelGHC.Int# -> PrelGHC.State# PrelGHC.RealWorld
-- -> (# PrelGHC.State# PrelGHC.RealWorld, PrelGHC.Int# #) -- -> (# PrelGHC.State# PrelGHC.RealWorld, PrelGHC.Int# #)
-- --
-- to [IntRep] -> IntRep -- to [IntRep] -> Just IntRep
-- and check that the last arg is VoidRep'd and that an unboxed pair is -- and check that the last arg is VoidRep'd and that an unboxed pair is
-- returned wherein the first arg is VoidRep'd. -- returned wherein the first arg is VoidRep'd.
--
-- Alternatively, for call-targets returning nothing, convert
--
-- PrelGHC.Int# -> PrelGHC.State# PrelGHC.RealWorld
-- -> (# PrelGHC.State# PrelGHC.RealWorld, PrelGHC.Int# #)
--
-- to [IntRep] -> Nothing
getCCallPrimReps :: Type -> ([PrimRep], PrimRep) getCCallPrimReps :: Type -> ([PrimRep], Maybe PrimRep)
getCCallPrimReps fn_ty getCCallPrimReps fn_ty
= let (a_tys, r_ty) = splitRepFunTys fn_ty = let (a_tys, r_ty) = splitRepFunTys fn_ty
a_reps = map typePrimRep a_tys a_reps = map typePrimRep a_tys
a_reps_to_go = init a_reps
maybe_r_rep_to_go
= if length r_reps == 1 then Nothing else Just (r_reps !! 1)
(r_tycon, r_reps) (r_tycon, r_reps)
= case splitTyConApp_maybe (repType r_ty) of = case splitTyConApp_maybe (repType r_ty) of
(Just (tyc, tys)) -> (tyc, map typePrimRep tys) (Just (tyc, tys)) -> (tyc, map typePrimRep tys)
Nothing -> blargh Nothing -> blargh
ok = length a_reps >= 1 && VoidRep == last a_reps ok = length a_reps >= 1 && VoidRep == last a_reps
&& length r_reps == 2 && VoidRep == head r_reps && ( (length r_reps == 2 && VoidRep == head r_reps)
|| r_reps == [VoidRep] )
&& isUnboxedTupleTyCon r_tycon && isUnboxedTupleTyCon r_tycon
&& PtrRep /= r_rep_to_go -- if it was, it would be impossible && case maybe_r_rep_to_go of
Nothing -> True
Just r_rep -> r_rep /= PtrRep
-- if it was, it would be impossible
-- to create a valid return value -- to create a valid return value
-- placeholder on the stack -- placeholder on the stack
a_reps_to_go = init a_reps
r_rep_to_go = r_reps !! 1
blargh = pprPanic "getCCallPrimReps: can't handle:" blargh = pprPanic "getCCallPrimReps: can't handle:"
(pprType fn_ty) (pprType fn_ty)
in in
--trace (showSDoc (ppr (a_reps, r_reps))) ( --trace (showSDoc (ppr (a_reps, r_reps))) (
if ok then (a_reps_to_go, r_rep_to_go) else blargh if ok then (a_reps_to_go, maybe_r_rep_to_go) else blargh
--) --)
atomRep (AnnVar v) = typePrimRep (idType v) atomRep (AnnVar v) = typePrimRep (idType v)
...@@ -1105,6 +1168,10 @@ unboxedTupleException ...@@ -1105,6 +1168,10 @@ unboxedTupleException
"\tto foreign import/export decls in source. Workaround:\n" ++ "\tto foreign import/export decls in source. Workaround:\n" ++
"\tcompile this module to a .o file, then restart session.")) "\tcompile this module to a .o file, then restart session."))
mkSLIDE n d = if d == 0 then nilOL else unitOL (SLIDE n d)
bind x f = f x
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -113,7 +113,7 @@ tcCheckFIType sig_ty arg_tys res_ty (CDynImport _) ...@@ -113,7 +113,7 @@ tcCheckFIType sig_ty arg_tys res_ty (CDynImport _)
tcCheckFIType sig_ty arg_tys res_ty (CImport (CCallSpec target _ safety)) tcCheckFIType sig_ty arg_tys res_ty (CImport (CCallSpec target _ safety))
| isDynamicTarget target -- Foreign import dynamic | isDynamicTarget target -- Foreign import dynamic
= checkCg checkCOrAsm `thenNF_Tc_` = checkCg checkCOrAsmOrInterp `thenNF_Tc_`
case arg_tys of -- The first arg must be Addr case arg_tys of -- The first arg must be Addr
[] -> check False (illegalForeignTyErr empty sig_ty) [] -> check False (illegalForeignTyErr empty sig_ty)
(arg1_ty:arg_tys) -> getDOptsTc `thenNF_Tc` \ dflags -> (arg1_ty:arg_tys) -> getDOptsTc `thenNF_Tc` \ dflags ->
...@@ -237,12 +237,20 @@ checkC other = Just (text "requires C code generation (-fvia-C)") ...@@ -237,12 +237,20 @@ checkC other = Just (text "requires C code generation (-fvia-C)")
checkCOrAsm HscC = Nothing checkCOrAsm HscC = Nothing
checkCOrAsm HscAsm = Nothing checkCOrAsm HscAsm = Nothing
checkCOrAsm other = Just (text "via-C or native code generation (-fvia-C)") checkCOrAsm other
= Just (text "requires via-C or native code generation (-fvia-C)")
checkCOrAsmOrInterp HscC = Nothing
checkCOrAsmOrInterp HscAsm = Nothing
checkCOrAsmOrInterp HscInterpreted = Nothing
checkCOrAsmOrInterp other
= Just (text "requires interpreted, C or native code generation")
checkCOrAsmOrDotNet HscC = Nothing checkCOrAsmOrDotNet HscC = Nothing
checkCOrAsmOrDotNet HscAsm = Nothing checkCOrAsmOrDotNet HscAsm = Nothing
checkCOrAsmOrDotNet HscILX = Nothing checkCOrAsmOrDotNet HscILX = Nothing
checkCOrAsmOrDotNet other = Just (text "requires C, native or .NET ILX code generation") checkCOrAsmOrDotNet other
= Just (text "requires C, native or .NET ILX code generation")
checkCOrAsmOrDotNetOrInterp HscC = Nothing checkCOrAsmOrDotNetOrInterp HscC = Nothing
checkCOrAsmOrDotNetOrInterp HscAsm = Nothing checkCOrAsmOrDotNetOrInterp HscAsm = Nothing
...@@ -266,7 +274,8 @@ check True _ = returnTc () ...@@ -266,7 +274,8 @@ check True _ = returnTc ()
check _ the_err = addErrTc the_err check _ the_err = addErrTc the_err
illegalForeignTyErr arg_or_res ty illegalForeignTyErr arg_or_res ty
= hang (hsep [ptext SLIT("Unacceptable"), arg_or_res, ptext SLIT("type in foreign declaration:")]) = hang (hsep [ptext SLIT("Unacceptable"), arg_or_res,
ptext SLIT("type in foreign declaration:")])
4 (hsep [ppr ty]) 4 (hsep [ppr ty])
-- Used for 'arg_or_res' argument to illegalForeignTyErr -- Used for 'arg_or_res' argument to illegalForeignTyErr
...@@ -274,7 +283,8 @@ argument = text "argument" ...@@ -274,7 +283,8 @@ argument = text "argument"
result = text "result" result = text "result"
badCName :: CLabelString -> Message badCName :: CLabelString -> Message
badCName target = sep [quotes (ppr target) <+> ptext SLIT("is not a valid C identifier")] badCName target
= sep [quotes (ppr target) <+> ptext SLIT("is not a valid C identifier")]
foreignDeclCtxt fo foreignDeclCtxt fo
= hang (ptext SLIT("When checking declaration:")) = hang (ptext SLIT("When checking declaration:"))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment