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