From 16513d4899e167d20e120c2b3907230b7ff9dd83 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 9 Aug 2006 09:52:01 +0000 Subject: [PATCH] Remove old FFI syntax See #815 --- compiler/deSugar/DsForeign.lhs | 11 +--- compiler/hsSyn/HsDecls.lhs | 10 +-- compiler/parser/Parser.y.pp | 131 +------------------------------------- compiler/parser/RdrHsSyn.lhs | 6 +- compiler/rename/RnNames.lhs | 2 +- compiler/rename/RnSource.lhs | 8 +-- compiler/typecheck/TcForeign.lhs | 12 ++-- compiler/typecheck/TcHsSyn.lhs | 4 +- 8 files changed, 25 insertions(+), 159 deletions(-) diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 46fc074..5d47921 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -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} diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index d8e1a34..e9ee026 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -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 diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index da16bff..3bb5ab4 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -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 } @@ -703,15 +590,8 @@ callconv :: { CallConv } 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 diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index d338b7c..cd82da1 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -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 diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 71d5c9b..63fd99d 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -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 diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 79721cf..bb26a3e 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -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 diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index fc98fdb..fa91028 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -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 ---------------------- diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index 6389f34..c850bdf 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -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} -- 1.7.10.4