Skip to content

GitLab

Commit 16513d48 authored by Simon Marlow's avatar Simon Marlow
Browse files

Remove old FFI syntax 

See #815
parent 7b1b3279
Hide whitespace changes
Inline Side-by-side
compiler/deSugar/DsForeign.lhs
View file @ 16513d48
......@@ -83,10 +83,9 @@ dsForeigns fos
combine stubs (L loc decl) = putSrcSpanDs loc (combine1 stubs decl)
combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f)
(ForeignImport id _ spec depr)
(ForeignImport id _ spec)
= traceIf (text "fi start" <+> ppr id) `thenDs` \ _ ->
dsFImport (unLoc id) spec `thenDs` \ (bs, h, c, mbhd) ->
warnDepr depr `thenDs` \ _ ->
traceIf (text "fi end" <+> ppr id) `thenDs` \ _ ->
returnDs (ForeignStubs (h $$ acc_h)
(c $$ acc_c)
......@@ -95,10 +94,9 @@ dsForeigns fos
bs ++ acc_f)
combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f)
(ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)) depr)
(ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)))
= dsFExport id (idType id)
ext_nm cconv False `thenDs` \(h, c, _, _) ->
warnDepr depr `thenDs` \_ ->
returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb),
acc_f)
......@@ -106,11 +104,6 @@ dsForeigns fos
addH (Just e) ls
| e `elem` ls = ls
| otherwise = e:ls
warnDepr False = returnDs ()
warnDepr True = dsWarn msg
where
msg = ptext SLIT("foreign declaration uses deprecated non-standard syntax")
\end{code}
......
compiler/hsSyn/HsDecls.lhs
View file @ 16513d48
......@@ -645,10 +645,10 @@ instance (OutputableBndr name)
type LForeignDecl name = Located (ForeignDecl name)
data ForeignDecl name
= ForeignImport (Located name) (LHsType name) ForeignImport Bool -- defines name
| ForeignExport (Located name) (LHsType name) ForeignExport Bool -- uses name
= ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
| ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
-- specification of an imported external entity in dependence on the calling
-- Specification Of an imported external entity in dependence on the calling
-- convention
--
data ForeignImport = -- import of a C entity
......@@ -698,10 +698,10 @@ data FoType = DNType -- In due course we'll add subtype stuff
--
instance OutputableBndr name => Outputable (ForeignDecl name) where
ppr (ForeignImport n ty fimport _) =
ppr (ForeignImport n ty fimport) =
ptext SLIT("foreign import") <+> ppr fimport <+>
ppr n <+> dcolon <+> ppr ty
ppr (ForeignExport n ty fexport _) =
ppr (ForeignExport n ty fexport) =
ptext SLIT("foreign export") <+> ppr fexport <+>
ppr n <+> dcolon <+> ppr ty
......
compiler/parser/Parser.y.pp
View file @ 16513d48
......@@ -83,10 +83,6 @@ Conflicts: 36 shift/reduce (1.25)
might be the start of the declaration with the activation being
empty. --SDM 1/4/2002
6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 393,394]
which are resolved correctly, and moreover,
should go away when `fdeclDEPRECATED' is removed.
1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 474]
since 'forall' is a valid variable name, we don't know whether
to treat a forall on the input as the beginning of a quantifier
......@@ -578,123 +574,14 @@ deprecation :: { OrdList (LHsDecl RdrName) }
-----------------------------------------------------------------------------
-- Foreign import and export declarations
-- for the time being, the following accepts foreign declarations conforming
-- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
--
-- * a flag indicates whether pre-standard declarations have been used and
-- triggers a deprecation warning further down the road
--
-- NB: The first two rules could be combined into one by replacing `safety1'
-- with `safety'. However, the combined rule conflicts with the
-- DEPRECATED rules.
--
fdecl :: { LHsDecl RdrName }
fdecl : 'import' callconv safety1 fspec
fdecl : 'import' callconv safety fspec
{% mkImport $2 $3 (unLoc $4) >>= return.LL }
| 'import' callconv fspec
| 'import' callconv fspec
{% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
return (LL d) } }
| 'export' callconv fspec
{% mkExport $2 (unLoc $3) >>= return.LL }
-- the following syntax is DEPRECATED
| fdecl1DEPRECATED { L1 (ForD (unLoc $1)) }
| fdecl2DEPRECATED { L1 (unLoc $1) }
fdecl1DEPRECATED :: { LForeignDecl RdrName }
fdecl1DEPRECATED
----------- DEPRECATED label decls ------------
: 'label' ext_name varid '::' sigtype
{ LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
(CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
----------- DEPRECATED ccall/stdcall decls ------------
--
-- NB: This business with the case expression below may seem overly
-- complicated, but it is necessary to avoid some conflicts.
-- DEPRECATED variant #1: lack of a calling convention specification
-- (import)
| 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
{ let
target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
in
LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
(CFunction target)) True }
-- DEPRECATED variant #2: external name consists of two separate strings
-- (module name and function name) (import)
| 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
{% case $2 of
DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
CCall cconv -> return $
let
imp = CFunction (StaticTarget (getSTRING $4))
in
LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
-- DEPRECATED variant #3: `unsafe' after entity
| 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
{% case $2 of
DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
CCall cconv -> return $
let
imp = CFunction (StaticTarget (getSTRING $3))
in
LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
-- DEPRECATED variant #4: use of the special identifier `dynamic' without
-- an explicit calling convention (import)
| 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
{ LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
(CFunction DynamicTarget)) True }
-- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
| 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
{% case $2 of
DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
CCall cconv -> return $
LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
(CFunction DynamicTarget)) True }
-- DEPRECATED variant #6: lack of a calling convention specification
-- (export)
| 'export' {-no callconv-} ext_name varid '::' sigtype
{ LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
defaultCCallConv)) True }
-- DEPRECATED variant #7: external name consists of two separate strings
-- (module name and function name) (export)
| 'export' callconv STRING STRING varid '::' sigtype
{% case $2 of
DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
CCall cconv -> return $
LL $ ForeignExport $5 $7
(CExport (CExportStatic (getSTRING $4) cconv)) True }
-- DEPRECATED variant #8: use of the special identifier `dynamic' without
-- an explicit calling convention (export)
| 'export' {-no callconv-} 'dynamic' varid '::' sigtype
{ LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
CWrapper) True }
-- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
| 'export' callconv 'dynamic' varid '::' sigtype
{% case $2 of
DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
CCall cconv -> return $
LL $ ForeignImport $4 $6
(CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
----------- DEPRECATED .NET decls ------------
-- NB: removed the .NET call declaration, as it is entirely subsumed
-- by the new standard FFI declarations
fdecl2DEPRECATED :: { LHsDecl RdrName }
fdecl2DEPRECATED
: 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
-- left this one unchanged for the moment as type imports are not
-- covered currently by the FFI standard -=chak
callconv :: { CallConv }
: 'stdcall' { CCall StdCallConv }
......@@ -702,16 +589,9 @@ callconv :: { CallConv }
| 'dotnet' { DNCall }
safety :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
| 'threadsafe' { PlaySafe True }
| {- empty -} { PlaySafe False }
safety1 :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
| 'threadsafe' { PlaySafe True }
-- only needed to avoid conflicts with the DEPRECATED rules
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
: STRING var '::' sigtype { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
......@@ -720,13 +600,6 @@ fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
-- the meaning of an empty entity string depends on the calling
-- convention
-- DEPRECATED syntax
ext_name :: { Maybe CLabelString }
: STRING { Just (getSTRING $1) }
| STRING STRING { Just (getSTRING $2) } -- Ignore "module name" for now
| {- empty -} { Nothing }
-----------------------------------------------------------------------------
-- Type signatures
......
compiler/parser/RdrHsSyn.lhs
View file @ 16513d48
......@@ -747,10 +747,10 @@ mkImport :: CallConv
-> P (HsDecl RdrName)
mkImport (CCall cconv) safety (entity, v, ty) = do
importSpec <- parseCImport entity cconv safety v
return (ForD (ForeignImport v ty importSpec False))
return (ForD (ForeignImport v ty importSpec))
mkImport (DNCall ) _ (entity, v, ty) = do
spec <- parseDImport entity
return $ ForD (ForeignImport v ty (DNImport spec) False)
return $ ForD (ForeignImport v ty (DNImport spec))
-- parse the entity string of a foreign import declaration for the `ccall' or
-- `stdcall' calling convention'
......@@ -851,7 +851,7 @@ mkExport :: CallConv
-> (Located FastString, Located RdrName, LHsType RdrName)
-> P (HsDecl RdrName)
mkExport (CCall cconv) (L loc entity, v, ty) = return $
ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)) False)
ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)))
where
entity' | nullFS entity = mkExtName (unLoc v)
| otherwise = entity
......
compiler/rename/RnNames.lhs
View file @ 16513d48
......@@ -430,7 +430,7 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
val_hs_bndrs = collectHsBindLocatedBinders val_decls
for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
new_tc tc_decl
= do { main_name <- newTopSrcBinder mod Nothing main_rdr
......
compiler/rename/RnSource.lhs
View file @ 16513d48
......@@ -246,15 +246,15 @@ rnDefaultDecl (DefaultDecl tys)
%*********************************************************
\begin{code}
rnHsForeignDecl (ForeignImport name ty spec isDeprec)
rnHsForeignDecl (ForeignImport name ty spec)
= lookupLocatedTopBndrRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
returnM (ForeignImport name' ty' spec isDeprec, fvs)
returnM (ForeignImport name' ty' spec, fvs)
rnHsForeignDecl (ForeignExport name ty spec isDeprec)
rnHsForeignDecl (ForeignExport name ty spec)
= lookupLocatedOccRn name `thenM` \ name' ->
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
returnM (ForeignExport name' ty' spec isDeprec, fvs )
returnM (ForeignExport name' ty' spec, fvs )
-- NB: a foreign export is an *occurrence site* for name, so
-- we add it to the free-variable list. It might, for example,
-- be imported from another module
......
compiler/typecheck/TcForeign.lhs
View file @ 16513d48
......@@ -59,12 +59,12 @@ import MachOp ( machRepByteWidth, MachHint(FloatHint) )
\begin{code}
-- Defines a binding
isForeignImport :: LForeignDecl name -> Bool
isForeignImport (L _ (ForeignImport _ _ _ _)) = True
isForeignImport (L _ (ForeignImport _ _ _)) = True
isForeignImport _ = False
-- Exports a binding
isForeignExport :: LForeignDecl name -> Bool
isForeignExport (L _ (ForeignExport _ _ _ _)) = True
isForeignExport (L _ (ForeignExport _ _ _)) = True
isForeignExport _ = False
\end{code}
......@@ -80,7 +80,7 @@ tcForeignImports decls
= mapAndUnzipM (wrapLocSndM tcFImport) (filter isForeignImport decls)
tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl isDeprec)
tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl)
= addErrCtxt (foreignDeclCtxt fo) $
tcHsSigType (ForSigCtxt nm) hs_ty `thenM` \ sig_ty ->
let
......@@ -96,7 +96,7 @@ tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl isDeprec)
tcCheckFIType sig_ty arg_tys res_ty imp_decl `thenM` \ imp_decl' ->
-- can't use sig_ty here because it :: Type and we need HsType Id
-- hence the undefined
returnM (id, ForeignImport (L loc id) undefined imp_decl' isDeprec)
returnM (id, ForeignImport (L loc id) undefined imp_decl')
\end{code}
......@@ -212,7 +212,7 @@ tcForeignExports decls
returnM (b `consBag` binds, f:fs)
tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id)
tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) =
tcFExport fo@(ForeignExport (L loc nm) hs_ty spec) =
addErrCtxt (foreignDeclCtxt fo) $
tcHsSigType (ForSigCtxt nm) hs_ty `thenM` \ sig_ty ->
......@@ -233,7 +233,7 @@ tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) =
id = mkExportedLocalId gnm sig_ty
bind = L loc (VarBind id rhs)
in
returnM (bind, ForeignExport (L loc id) undefined spec isDeprec)
returnM (bind, ForeignExport (L loc id) undefined spec)
\end{code}
------------ Checking argument types for foreign export ----------------------
......
compiler/typecheck/TcHsSyn.lhs
View file @ 16513d48
......@@ -811,8 +811,8 @@ zonkForeignExports :: ZonkEnv -> [LForeignDecl TcId] -> TcM [LForeignDecl Id]
zonkForeignExports env ls = mappM (wrapLocM (zonkForeignExport env)) ls
zonkForeignExport :: ZonkEnv -> ForeignDecl TcId -> TcM (ForeignDecl Id)
zonkForeignExport env (ForeignExport i hs_ty spec isDeprec) =
returnM (ForeignExport (fmap (zonkIdOcc env) i) undefined spec isDeprec)
zonkForeignExport env (ForeignExport i hs_ty spec) =
returnM (ForeignExport (fmap (zonkIdOcc env) i) undefined spec)
zonkForeignExport env for_imp
= returnM for_imp -- Foreign imports don't need zonking
\end{code}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment