diff options
Diffstat (limited to 'compiler/GHC/Tc/Gen/Foreign.hs')
| -rw-r--r-- | compiler/GHC/Tc/Gen/Foreign.hs | 25 |
1 files changed, 5 insertions, 20 deletions
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs index b1c38a7166..372c39358c 100644 --- a/compiler/GHC/Tc/Gen/Foreign.hs +++ b/compiler/GHC/Tc/Gen/Foreign.hs @@ -268,8 +268,7 @@ tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src) -- Foreign import label - = do checkCg checkCOrAsmOrLlvmOrInterp - -- NB check res_ty not sig_ty! + = do -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) cconv' <- checkCConv cconv @@ -280,7 +279,6 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid -- foreign type. For legacy reasons ft -> IO (Ptr ft) is accepted, too. -- The use of the latter form is DEPRECATED, though. - checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of [Scaled arg1_mult arg1_ty] -> do @@ -296,7 +294,6 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh (CFunction target) src) | isDynamicTarget target = do -- Foreign import dynamic - checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of -- The first arg must be Ptr or FunPtr [] -> @@ -315,7 +312,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh checkTc (xopt LangExt.GHCForeignImportPrim dflags) (TcRnUnknownMessage $ mkPlainError noHints $ text "Use GHCForeignImportPrim to allow `foreign import prim'.") - checkCg checkCOrAsmOrLlvmOrInterp checkCTarget target checkTc (playSafe safety) (TcRnUnknownMessage $ mkPlainError noHints $ @@ -325,7 +321,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty return idecl | otherwise = do -- Normal foreign import - checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv checkCTarget target dflags <- getDynFlags @@ -345,7 +340,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh -- that the C identifier is valid for C checkCTarget :: CCallTarget -> TcM () checkCTarget (StaticTarget _ str _ _) = do - checkCg checkCOrAsmOrLlvmOrInterp checkTc (isCLabelString str) (badCName str) checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget" @@ -506,30 +500,21 @@ checkSafe = True noCheckSafe = False -- | Checking a supported backend is in use -checkCOrAsmOrLlvm :: Backend -> Validity +checkCOrAsmOrLlvm :: ActualBackend -> Validity checkCOrAsmOrLlvm ViaC = IsValid checkCOrAsmOrLlvm NCG = IsValid checkCOrAsmOrLlvm LLVM = IsValid checkCOrAsmOrLlvm _ = NotValid (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)") --- | Checking a supported backend is in use -checkCOrAsmOrLlvmOrInterp :: Backend -> Validity -checkCOrAsmOrLlvmOrInterp ViaC = IsValid -checkCOrAsmOrLlvmOrInterp NCG = IsValid -checkCOrAsmOrLlvmOrInterp LLVM = IsValid -checkCOrAsmOrLlvmOrInterp Interpreter = IsValid -checkCOrAsmOrLlvmOrInterp _ - = NotValid (text "requires interpreted, unregisterised, llvm or native code generation") - -checkCg :: (Backend -> Validity) -> TcM () +checkCg :: (ActualBackend -> Validity) -> TcM () checkCg check = do dflags <- getDynFlags let bcknd = backend dflags case bcknd of NoBackend -> return () - _ -> - case check bcknd of + Just bcknd' -> + case check bcknd' of IsValid -> return () NotValid err -> addErrTc (TcRnUnknownMessage $ mkPlainError noHints $ text "Illegal foreign declaration:" <+> err) |