diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Builtin/Names.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Foreign/C.hs | 12 |
2 files changed, 5 insertions, 19 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 691f500a77..780c0738b3 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -350,7 +350,7 @@ basicKnownKeyNames zipName, foldrName, buildName, augmentName, appendName, -- FFI primitive types that are not wired-in. - stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName, + stablePtrTyConName, ptrTyConName, funPtrTyConName, int8TyConName, int16TyConName, int32TyConName, int64TyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName, @@ -557,7 +557,7 @@ gHC_PRIM, gHC_PRIM_PANIC, aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST, cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL, gHC_TYPENATS, gHC_TYPENATS_INTERNAL, - dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_TYPES :: Module + dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic") @@ -626,7 +626,6 @@ gHC_TYPENATS_INTERNAL = mkBaseModule (fsLit "GHC.TypeNats.Internal") dATA_COERCE = mkBaseModule (fsLit "Data.Coerce") dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace") uNSAFE_COERCE = mkBaseModule (fsLit "Unsafe.Coerce") -fOREIGN_C_TYPES = mkBaseModule (fsLit "Foreign.C.Types") gHC_SRCLOC :: Module gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc") @@ -1665,10 +1664,6 @@ fingerprintDataConName :: Name fingerprintDataConName = dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey -constPtrConName :: Name -constPtrConName = - tcQual fOREIGN_C_TYPES (fsLit "ConstPtr") constPtrTyConKey - {- ************************************************************************ * * @@ -1870,7 +1865,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey, funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, eqReprPrimTyConKey, eqPhantPrimTyConKey, compactPrimTyConKey, stackSnapshotPrimTyConKey, - promptTagPrimTyConKey, constPtrTyConKey :: Unique + promptTagPrimTyConKey :: Unique statePrimTyConKey = mkPreludeTyConUnique 50 stableNamePrimTyConKey = mkPreludeTyConUnique 51 stableNameTyConKey = mkPreludeTyConUnique 52 @@ -2081,7 +2076,6 @@ typeConsSymbolTyFamNameKey = mkPreludeTyConUnique 413 typeUnconsSymbolTyFamNameKey = mkPreludeTyConUnique 414 typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415 typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416 -constPtrTyConKey = mkPreludeTyConUnique 417 {- ************************************************************************ diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs index 28ef42e2b9..160e9acc97 100644 --- a/compiler/GHC/HsToCore/Foreign/C.hs +++ b/compiler/GHC/HsToCore/Foreign/C.hs @@ -246,18 +246,10 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header -> DsM ([(Id, Expr TyVar)], CHeader, CStub) dsFCall fn_id co fcall mDeclHeader = do let - (ty,ty1) = (coercionLKind co, coercionRKind co) + ty = coercionLKind co (tv_bndrs, rho) = tcSplitForAllTyVarBinders ty (arg_tys, io_res_ty) = tcSplitFunTys rho - let constQual -- provide 'const' qualifier (#22034) - | (_, res_ty1) <- tcSplitFunTys ty1 - , newty <- maybe res_ty1 snd (tcSplitIOType_maybe res_ty1) - , Just (ptr, _) <- splitTyConApp_maybe newty - , tyConName ptr `elem` [constPtrConName] - = text "const" - | otherwise = empty - args <- newSysLocalsDs arg_tys -- no FFI representation polymorphism (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args) @@ -285,7 +277,7 @@ dsFCall fn_id co fcall mDeclHeader = do includes = vcat [ text "#include \"" <> ftext h <> text "\"" | Header _ h <- nub headers ] - fun_proto = constQual <+> cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes + fun_proto = cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes cRet | isVoidRes = cCall | otherwise = text "return" <+> cCall |