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