454cde4d708da0bf7ad9c7c1f23628e6afe6c91f
[ghc.git] / compiler / typecheck / TcForeign.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1998
4
5 \section[TcForeign]{Typechecking \tr{foreign} declarations}
6
7 A foreign declaration is used to either give an externally
8 implemented function a Haskell type (and calling interface) or
9 give a Haskell function an external calling interface. Either way,
10 the range of argument and result types these functions can accommodate
11 is restricted to what the outside world understands (read C), and this
12 module checks to see if a foreign declaration has got a legal type.
13 -}
14
15 {-# LANGUAGE CPP #-}
16
17 module TcForeign
18 ( tcForeignImports
19 , tcForeignExports
20
21 -- Low-level exports for hooks
22 , isForeignImport, isForeignExport
23 , tcFImport, tcFExport
24 , tcForeignImports'
25 , tcCheckFIType, checkCTarget, checkForeignArgs, checkForeignRes
26 , normaliseFfiType
27 , nonIOok, mustBeIO
28 , checkSafe, noCheckSafe
29 , tcForeignExports'
30 , tcCheckFEType
31 ) where
32
33 #include "HsVersions.h"
34
35 import HsSyn
36
37 import TcRnMonad
38 import TcHsType
39 import TcExpr
40 import TcEnv
41
42 import FamInst
43 import FamInstEnv
44 import Coercion
45 import Type
46 import ForeignCall
47 import ErrUtils
48 import Id
49 import Name
50 import RdrName
51 import DataCon
52 import TyCon
53 import TcType
54 import PrelNames
55 import DynFlags
56 import Outputable
57 import Platform
58 import SrcLoc
59 import Bag
60 import FastString
61 import Hooks
62
63 import Control.Monad
64 import Data.Maybe
65
66 -- Defines a binding
67 isForeignImport :: LForeignDecl name -> Bool
68 isForeignImport (L _ (ForeignImport {})) = True
69 isForeignImport _ = False
70
71 -- Exports a binding
72 isForeignExport :: LForeignDecl name -> Bool
73 isForeignExport (L _ (ForeignExport {})) = True
74 isForeignExport _ = False
75
76 {-
77 Note [Don't recur in normaliseFfiType']
78 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
79 normaliseFfiType' is the workhorse for normalising a type used in a foreign
80 declaration. If we have
81
82 newtype Age = MkAge Int
83
84 we want to see that Age -> IO () is the same as Int -> IO (). But, we don't
85 need to recur on any type parameters, because no paramaterized types (with
86 interesting parameters) are marshalable! The full list of marshalable types
87 is in the body of boxedMarshalableTyCon in TcType. The only members of that
88 list not at kind * are Ptr, FunPtr, and StablePtr, all of which get marshaled
89 the same way regardless of type parameter. So, no need to recur into
90 parameters.
91
92 Similarly, we don't need to look in AppTy's, because nothing headed by
93 an AppTy will be marshalable.
94
95 Note [FFI type roles]
96 ~~~~~~~~~~~~~~~~~~~~~
97 The 'go' helper function within normaliseFfiType' always produces
98 representational coercions. But, in the "children_only" case, we need to
99 use these coercions in a TyConAppCo. Accordingly, the roles on the coercions
100 must be twiddled to match the expectation of the enclosing TyCon. However,
101 we cannot easily go from an R coercion to an N one, so we forbid N roles
102 on FFI type constructors. Currently, only two such type constructors exist:
103 IO and FunPtr. Thus, this is not an onerous burden.
104
105 If we ever want to lift this restriction, we would need to make 'go' take
106 the target role as a parameter. This wouldn't be hard, but it's a complication
107 not yet necessary and so is not yet implemented.
108 -}
109
110 -- normaliseFfiType takes the type from an FFI declaration, and
111 -- evaluates any type synonyms, type functions, and newtypes. However,
112 -- we are only allowed to look through newtypes if the constructor is
113 -- in scope. We return a bag of all the newtype constructors thus found.
114 -- Always returns a Representational coercion
115 normaliseFfiType :: Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
116 normaliseFfiType ty
117 = do fam_envs <- tcGetFamInstEnvs
118 normaliseFfiType' fam_envs ty
119
120 normaliseFfiType' :: FamInstEnvs -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
121 normaliseFfiType' env ty0 = go initRecTc ty0
122 where
123 go :: RecTcChecker -> Type -> TcM (Coercion, Type, Bag GlobalRdrElt)
124 go rec_nts ty
125 | Just ty' <- coreView ty -- Expand synonyms
126 = go rec_nts ty'
127
128 | Just (tc, tys) <- splitTyConApp_maybe ty
129 = go_tc_app rec_nts tc tys
130
131 | Just (bndr, inner_ty) <- splitPiTy_maybe ty
132 , Just tyvar <- binderVar_maybe bndr
133 = do (coi, nty1, gres1) <- go rec_nts inner_ty
134 return ( mkHomoForAllCos [tyvar] coi
135 , mkForAllTy bndr nty1, gres1 )
136
137 | otherwise -- see Note [Don't recur in normaliseFfiType']
138 = return (mkRepReflCo ty, ty, emptyBag)
139
140 go_tc_app :: RecTcChecker -> TyCon -> [Type]
141 -> TcM (Coercion, Type, Bag GlobalRdrElt)
142 go_tc_app rec_nts tc tys
143 -- We don't want to look through the IO newtype, even if it is
144 -- in scope, so we have a special case for it:
145 | tc_key `elem` [ioTyConKey, funPtrTyConKey, funTyConKey]
146 -- These *must not* have nominal roles on their parameters!
147 -- See Note [FFI type roles]
148 = children_only
149
150 | isNewTyCon tc -- Expand newtypes
151 , Just rec_nts' <- checkRecTc rec_nts tc
152 -- See Note [Expanding newtypes] in TyCon.hs
153 -- We can't just use isRecursiveTyCon; sometimes recursion is ok:
154 -- newtype T = T (Ptr T)
155 -- Here, we don't reject the type for being recursive.
156 -- If this is a recursive newtype then it will normally
157 -- be rejected later as not being a valid FFI type.
158 = do { rdr_env <- getGlobalRdrEnv
159 ; case checkNewtypeFFI rdr_env tc of
160 Nothing -> nothing
161 Just gre -> do { (co', ty', gres) <- go rec_nts' nt_rhs
162 ; return (mkTransCo nt_co co', ty', gre `consBag` gres) } }
163
164 | isFamilyTyCon tc -- Expand open tycons
165 , (co, ty) <- normaliseTcApp env Representational tc tys
166 , not (isReflCo co)
167 = do (co', ty', gres) <- go rec_nts ty
168 return (mkTransCo co co', ty', gres)
169
170 | otherwise
171 = nothing -- see Note [Don't recur in normaliseFfiType']
172 where
173 tc_key = getUnique tc
174 children_only
175 = do xs <- mapM (go rec_nts) tys
176 let (cos, tys', gres) = unzip3 xs
177 -- the (repeat Representational) is because 'go' always
178 -- returns R coercions
179 cos' = zipWith3 downgradeRole (tyConRoles tc)
180 (repeat Representational) cos
181 return ( mkTyConAppCo Representational tc cos'
182 , mkTyConApp tc tys', unionManyBags gres)
183 nt_co = mkUnbranchedAxInstCo Representational (newTyConCo tc) tys []
184 nt_rhs = newTyConInstRhs tc tys
185
186 ty = mkTyConApp tc tys
187 nothing = return (mkRepReflCo ty, ty, emptyBag)
188
189 checkNewtypeFFI :: GlobalRdrEnv -> TyCon -> Maybe GlobalRdrElt
190 checkNewtypeFFI rdr_env tc
191 | Just con <- tyConSingleDataCon_maybe tc
192 , [gre] <- lookupGRE_Name rdr_env (dataConName con)
193 = Just gre -- See Note [Newtype constructor usage in foreign declarations]
194 | otherwise
195 = Nothing
196
197 {-
198 Note [Newtype constructor usage in foreign declarations]
199 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
200 GHC automatically "unwraps" newtype constructors in foreign import/export
201 declarations. In effect that means that a newtype data constructor is
202 used even though it is not mentioned expclitly in the source, so we don't
203 want to report it as "defined but not used" or "imported but not used".
204 eg newtype D = MkD Int
205 foreign import foo :: D -> IO ()
206 Here 'MkD' us used. See Trac #7408.
207
208 GHC also expands type functions during this process, so it's not enough
209 just to look at the free variables of the declaration.
210 eg type instance F Bool = D
211 foreign import bar :: F Bool -> IO ()
212 Here again 'MkD' is used.
213
214 So we really have wait until the type checker to decide what is used.
215 That's why tcForeignImports and tecForeignExports return a (Bag GRE)
216 for the newtype constructors they see. Then TcRnDriver can add them
217 to the module's usages.
218
219
220 ************************************************************************
221 * *
222 \subsection{Imports}
223 * *
224 ************************************************************************
225 -}
226
227 tcForeignImports :: [LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt)
228 tcForeignImports decls
229 = getHooked tcForeignImportsHook tcForeignImports' >>= ($ decls)
230
231 tcForeignImports' :: [LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt)
232 -- For the (Bag GlobalRdrElt) result,
233 -- see Note [Newtype constructor usage in foreign declarations]
234 tcForeignImports' decls
235 = do { (ids, decls, gres) <- mapAndUnzip3M tcFImport $
236 filter isForeignImport decls
237 ; return (ids, decls, unionManyBags gres) }
238
239 tcFImport :: LForeignDecl Name -> TcM (Id, LForeignDecl Id, Bag GlobalRdrElt)
240 tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty
241 , fd_fi = imp_decl }))
242 = setSrcSpan dloc $ addErrCtxt (foreignDeclCtxt fo) $
243 do { sig_ty <- solveEqualities $ tcHsSigType (ForSigCtxt nm) hs_ty
244 ; (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty
245 ; let
246 -- Drop the foralls before inspecting the
247 -- structure of the foreign type.
248 (bndrs, res_ty) = tcSplitPiTys norm_sig_ty
249 arg_tys = mapMaybe binderRelevantType_maybe bndrs
250 id = mkLocalId nm sig_ty
251 -- Use a LocalId to obey the invariant that locally-defined
252 -- things are LocalIds. However, it does not need zonking,
253 -- (so TcHsSyn.zonkForeignExports ignores it).
254
255 ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl
256 -- Can't use sig_ty here because sig_ty :: Type and
257 -- we need HsType Id hence the undefined
258 ; let fi_decl = ForeignImport { fd_name = L nloc id
259 , fd_sig_ty = undefined
260 , fd_co = mkSymCo norm_co
261 , fd_fi = imp_decl' }
262 ; return (id, L dloc fi_decl, gres) }
263 tcFImport d = pprPanic "tcFImport" (ppr d)
264
265 -- ------------ Checking types for foreign import ----------------------
266
267 tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport
268
269 tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src)
270 -- Foreign import label
271 = do checkCg checkCOrAsmOrLlvmOrInterp
272 -- NB check res_ty not sig_ty!
273 -- In case sig_ty is (forall a. ForeignPtr a)
274 check (isFFILabelTy (mkFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty)
275 cconv' <- checkCConv cconv
276 return (CImport (L lc cconv') safety mh l src)
277
278 tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do
279 -- Foreign wrapper (former f.e.d.)
280 -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
281 -- foreign type. For legacy reasons ft -> IO (Ptr ft) is accepted, too.
282 -- The use of the latter form is DEPRECATED, though.
283 checkCg checkCOrAsmOrLlvmOrInterp
284 cconv' <- checkCConv cconv
285 case arg_tys of
286 [arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
287 checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty
288 checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
289 where
290 (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
291 _ -> addErrTc (illegalForeignTyErr Outputable.empty (ptext (sLit "One argument expected")))
292 return (CImport (L lc cconv') safety mh CWrapper src)
293
294 tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
295 (CFunction target) src)
296 | isDynamicTarget target = do -- Foreign import dynamic
297 checkCg checkCOrAsmOrLlvmOrInterp
298 cconv' <- checkCConv cconv
299 case arg_tys of -- The first arg must be Ptr or FunPtr
300 [] ->
301 addErrTc (illegalForeignTyErr Outputable.empty (ptext (sLit "At least one argument expected")))
302 (arg1_ty:arg_tys) -> do
303 dflags <- getDynFlags
304 let curried_res_ty = mkFunTys arg_tys res_ty
305 check (isFFIDynTy curried_res_ty arg1_ty)
306 (illegalForeignTyErr argument)
307 checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
308 checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
309 return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src
310 | cconv == PrimCallConv = do
311 dflags <- getDynFlags
312 checkTc (xopt Opt_GHCForeignImportPrim dflags)
313 (text "Use GHCForeignImportPrim to allow `foreign import prim'.")
314 checkCg checkCOrAsmOrLlvmOrInterp
315 checkCTarget target
316 checkTc (playSafe safety)
317 (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
318 checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
319 -- prim import result is more liberal, allows (#,,#)
320 checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
321 return idecl
322 | otherwise = do -- Normal foreign import
323 checkCg checkCOrAsmOrLlvmOrInterp
324 cconv' <- checkCConv cconv
325 checkCTarget target
326 dflags <- getDynFlags
327 checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
328 checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
329 checkMissingAmpersand dflags arg_tys res_ty
330 case target of
331 StaticTarget _ _ _ False
332 | not (null arg_tys) ->
333 addErrTc (text "`value' imports cannot have function types")
334 _ -> return ()
335 return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src
336
337
338 -- This makes a convenient place to check
339 -- that the C identifier is valid for C
340 checkCTarget :: CCallTarget -> TcM ()
341 checkCTarget (StaticTarget _ str _ _) = do
342 checkCg checkCOrAsmOrLlvmOrInterp
343 checkTc (isCLabelString str) (badCName str)
344
345 checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
346
347
348 checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
349 checkMissingAmpersand dflags arg_tys res_ty
350 | null arg_tys && isFunPtrTy res_ty &&
351 wopt Opt_WarnDodgyForeignImports dflags
352 = addWarn (ptext (sLit "possible missing & in foreign import of FunPtr"))
353 | otherwise
354 = return ()
355
356 {-
357 ************************************************************************
358 * *
359 \subsection{Exports}
360 * *
361 ************************************************************************
362 -}
363
364 tcForeignExports :: [LForeignDecl Name]
365 -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt)
366 tcForeignExports decls =
367 getHooked tcForeignExportsHook tcForeignExports' >>= ($ decls)
368
369 tcForeignExports' :: [LForeignDecl Name]
370 -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt)
371 -- For the (Bag GlobalRdrElt) result,
372 -- see Note [Newtype constructor usage in foreign declarations]
373 tcForeignExports' decls
374 = foldlM combine (emptyLHsBinds, [], emptyBag) (filter isForeignExport decls)
375 where
376 combine (binds, fs, gres1) (L loc fe) = do
377 (b, f, gres2) <- setSrcSpan loc (tcFExport fe)
378 return (b `consBag` binds, L loc f : fs, gres1 `unionBags` gres2)
379
380 tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id, Bag GlobalRdrElt)
381 tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spec })
382 = addErrCtxt (foreignDeclCtxt fo) $ do
383
384 sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
385 rhs <- tcPolyExpr (nlHsVar nm) sig_ty
386
387 (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty
388
389 spec' <- tcCheckFEType norm_sig_ty spec
390
391 -- we're exporting a function, but at a type possibly more
392 -- constrained than its declared/inferred type. Hence the need
393 -- to create a local binding which will call the exported function
394 -- at a particular type (and, maybe, overloading).
395
396
397 -- We need to give a name to the new top-level binding that
398 -- is *stable* (i.e. the compiler won't change it later),
399 -- because this name will be referred to by the C code stub.
400 id <- mkStableIdFromName nm sig_ty loc mkForeignExportOcc
401 return ( mkVarBind id rhs
402 , ForeignExport { fd_name = L loc id
403 , fd_sig_ty = undefined
404 , fd_co = norm_co, fd_fe = spec' }
405 , gres)
406 tcFExport d = pprPanic "tcFExport" (ppr d)
407
408 -- ------------ Checking argument types for foreign export ----------------------
409
410 tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
411 tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do
412 checkCg checkCOrAsmOrLlvm
413 checkTc (isCLabelString str) (badCName str)
414 cconv' <- checkCConv cconv
415 checkForeignArgs isFFIExternalTy arg_tys
416 checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
417 return (CExport (L l (CExportStatic esrc str cconv')) src)
418 where
419 -- Drop the foralls before inspecting n
420 -- the structure of the foreign type.
421 (bndrs, res_ty) = tcSplitPiTys sig_ty
422 arg_tys = mapMaybe binderRelevantType_maybe bndrs
423
424 {-
425 ************************************************************************
426 * *
427 \subsection{Miscellaneous}
428 * *
429 ************************************************************************
430 -}
431
432 ------------ Checking argument types for foreign import ----------------------
433 checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM ()
434 checkForeignArgs pred tys = mapM_ go tys
435 where
436 go ty = check (pred ty) (illegalForeignTyErr argument)
437
438 ------------ Checking result types for foreign calls ----------------------
439 -- | Check that the type has the form
440 -- (IO t) or (t) , and that t satisfies the given predicate.
441 -- When calling this function, any newtype wrappers (should) have been
442 -- already dealt with by normaliseFfiType.
443 --
444 -- We also check that the Safe Haskell condition of FFI imports having
445 -- results in the IO monad holds.
446 --
447 checkForeignRes :: Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
448 checkForeignRes non_io_result_ok check_safe pred_res_ty ty
449 | Just (_, res_ty) <- tcSplitIOType_maybe ty
450 = -- Got an IO result type, that's always fine!
451 check (pred_res_ty res_ty) (illegalForeignTyErr result)
452
453 -- Case for non-IO result type with FFI Import
454 | not non_io_result_ok
455 = addErrTc $ illegalForeignTyErr result (ptext (sLit "IO result type expected"))
456
457 | otherwise
458 = do { dflags <- getDynFlags
459 ; case pred_res_ty ty of
460 -- Handle normal typecheck fail, we want to handle this first and
461 -- only report safe haskell errors if the normal type check is OK.
462 NotValid msg -> addErrTc $ illegalForeignTyErr result msg
463
464 -- handle safe infer fail
465 _ | check_safe && safeInferOn dflags
466 -> recordUnsafeInfer emptyBag
467
468 -- handle safe language typecheck fail
469 _ | check_safe && safeLanguageOn dflags
470 -> addErrTc (illegalForeignTyErr result safeHsErr)
471
472 -- success! non-IO return is fine
473 _ -> return () }
474 where
475 safeHsErr = ptext $ sLit "Safe Haskell is on, all FFI imports must be in the IO monad"
476
477 nonIOok, mustBeIO :: Bool
478 nonIOok = True
479 mustBeIO = False
480
481 checkSafe, noCheckSafe :: Bool
482 checkSafe = True
483 noCheckSafe = False
484
485 -- Checking a supported backend is in use
486
487 checkCOrAsmOrLlvm :: HscTarget -> Validity
488 checkCOrAsmOrLlvm HscC = IsValid
489 checkCOrAsmOrLlvm HscAsm = IsValid
490 checkCOrAsmOrLlvm HscLlvm = IsValid
491 checkCOrAsmOrLlvm _
492 = NotValid (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")
493
494 checkCOrAsmOrLlvmOrInterp :: HscTarget -> Validity
495 checkCOrAsmOrLlvmOrInterp HscC = IsValid
496 checkCOrAsmOrLlvmOrInterp HscAsm = IsValid
497 checkCOrAsmOrLlvmOrInterp HscLlvm = IsValid
498 checkCOrAsmOrLlvmOrInterp HscInterpreted = IsValid
499 checkCOrAsmOrLlvmOrInterp _
500 = NotValid (text "requires interpreted, unregisterised, llvm or native code generation")
501
502 checkCg :: (HscTarget -> Validity) -> TcM ()
503 checkCg check = do
504 dflags <- getDynFlags
505 let target = hscTarget dflags
506 case target of
507 HscNothing -> return ()
508 _ ->
509 case check target of
510 IsValid -> return ()
511 NotValid err -> addErrTc (text "Illegal foreign declaration:" <+> err)
512
513 -- Calling conventions
514
515 checkCConv :: CCallConv -> TcM CCallConv
516 checkCConv CCallConv = return CCallConv
517 checkCConv CApiConv = return CApiConv
518 checkCConv StdCallConv = do dflags <- getDynFlags
519 let platform = targetPlatform dflags
520 if platformArch platform == ArchX86
521 then return StdCallConv
522 else do -- This is a warning, not an error. see #3336
523 when (wopt Opt_WarnUnsupportedCallingConventions dflags) $
524 addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform," $$ text "treating as ccall")
525 return CCallConv
526 checkCConv PrimCallConv = do addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
527 return PrimCallConv
528 checkCConv JavaScriptCallConv = do dflags <- getDynFlags
529 if platformArch (targetPlatform dflags) == ArchJavaScript
530 then return JavaScriptCallConv
531 else do addErrTc (text "The `javascript' calling convention is unsupported on this platform")
532 return JavaScriptCallConv
533
534 -- Warnings
535
536 check :: Validity -> (MsgDoc -> MsgDoc) -> TcM ()
537 check IsValid _ = return ()
538 check (NotValid doc) err_fn = addErrTc (err_fn doc)
539
540 illegalForeignTyErr :: SDoc -> SDoc -> SDoc
541 illegalForeignTyErr arg_or_res extra
542 = hang msg 2 extra
543 where
544 msg = hsep [ ptext (sLit "Unacceptable"), arg_or_res
545 , ptext (sLit "type in foreign declaration:")]
546
547 -- Used for 'arg_or_res' argument to illegalForeignTyErr
548 argument, result :: SDoc
549 argument = text "argument"
550 result = text "result"
551
552 badCName :: CLabelString -> MsgDoc
553 badCName target
554 = sep [quotes (ppr target) <+> ptext (sLit "is not a valid C identifier")]
555
556 foreignDeclCtxt :: ForeignDecl Name -> SDoc
557 foreignDeclCtxt fo
558 = hang (ptext (sLit "When checking declaration:"))
559 2 (ppr fo)