Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
16513d48
Commit
16513d48
authored
Aug 09, 2006
by
Simon Marlow
Browse files
Remove old FFI syntax
See
#815
parent
7b1b3279
Changes
8
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
--
s
pecification
o
f an imported external entity in dependence on the calling
--
S
pecification
O
f 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
safety
1
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}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment