Commit 5f1979b7 authored by sof's avatar sof
Browse files

[project @ 1999-09-01 14:08:19 by sof]

* On foreign decls, "ext_name"s are now optional. If missing, the ext_name
  is made equal to the Haskell name.
* Half a dozen special-ids were incorrectly handled when occurring as tyvars.
parent 835564a7
......@@ -128,6 +128,8 @@ data Token
| ITlabel
| ITdynamic
| ITunsafe
| ITstdcallconv
| ITccallconv
| ITinterface -- interface keywords
| IT__export
......@@ -280,6 +282,8 @@ ghcExtensionKeywordsFM = listToUFM $
( "label", ITlabel ),
( "dynamic", ITdynamic ),
( "unsafe", ITunsafe ),
( "stdcall", ITstdcallconv),
( "ccall", ITccallconv),
("_ccall_", ITccall (False, False, False)),
("_ccall_GC_", ITccall (False, False, True)),
("_casm_", ITccall (False, True, False)),
......
......@@ -13,9 +13,10 @@ module ParseUtil (
, mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp
, groupBindings
, mkExtName -- Maybe ExtName -> RdrName -> ExtName
, checkPrec -- String -> P String
, checkCallConv -- FAST_STRING -> P CallConv
, checkContext -- HsType -> P HsContext
, checkInstType -- HsType -> P HsType
, checkAssertion -- HsType -> P HsAsst
......@@ -35,10 +36,11 @@ module ParseUtil (
-- pseudo-keywords, in var and tyvar forms (all :: RdrName)
, as_var_RDR, hiding_var_RDR, qualified_var_RDR, forall_var_RDR
, export_var_RDR, label_var_RDR, dynamic_var_RDR, unsafe_var_RDR
, stdcall_var_RDR, ccall_var_RDR
, as_tyvar_RDR, hiding_tyvar_RDR, qualified_tyvar_RDR
, export_tyvar_RDR, label_tyvar_RDR, dynamic_tyvar_RDR
, unsafe_tyvar_RDR
, unsafe_tyvar_RDR, stdcall_tyvar_RDR, ccall_tyvar_RDR
, minus_RDR, pling_RDR, dot_RDR
......@@ -53,7 +55,7 @@ import RdrHsSyn
import RdrName
import CallConv
import PrelMods ( pRELUDE_Name, mkUbxTupNameStr, mkTupNameStr )
import OccName ( dataName, tcName, varName, tvName, setOccNameSpace )
import OccName ( dataName, tcName, varName, tvName, setOccNameSpace, occNameFS )
import CmdLineOpts ( opt_NoImplicitPrelude )
import StringBuffer ( lexemeToString )
import FastString ( unpackFS )
......@@ -354,6 +356,14 @@ mkRecConstrOrUpdate exp fs@(_:_)
mkRecConstrOrUpdate _ _
= parseError "Empty record update"
-- supplying the ext_name in a foreign decl is optional ; if it
-- isn't there, the Haskell name is assumed. Note that no transformation
-- of the Haskell name is then performed, so if you foreign export (++),
-- it's external name will be "++". Too bad.
mkExtName :: Maybe ExtName -> RdrName -> ExtName
mkExtName Nothing rdrNm = ExtName (occNameFS (rdrNameOcc rdrNm)) Nothing
mkExtName (Just x) _ = x
-----------------------------------------------------------------------------
-- group function bindings into equation groups
......@@ -436,6 +446,8 @@ exportName = SLIT("export")
labelName = SLIT("label")
dynamicName = SLIT("dynamic")
unsafeName = SLIT("unsafe")
stdcallName = SLIT("stdcall")
ccallName = SLIT("ccall")
as_var_RDR = mkSrcUnqual varName asName
hiding_var_RDR = mkSrcUnqual varName hidingName
......@@ -445,6 +457,8 @@ export_var_RDR = mkSrcUnqual varName exportName
label_var_RDR = mkSrcUnqual varName labelName
dynamic_var_RDR = mkSrcUnqual varName dynamicName
unsafe_var_RDR = mkSrcUnqual varName unsafeName
stdcall_var_RDR = mkSrcUnqual varName stdcallName
ccall_var_RDR = mkSrcUnqual varName ccallName
as_tyvar_RDR = mkSrcUnqual tvName asName
hiding_tyvar_RDR = mkSrcUnqual tvName hidingName
......@@ -453,6 +467,8 @@ export_tyvar_RDR = mkSrcUnqual tvName exportName
label_tyvar_RDR = mkSrcUnqual tvName labelName
dynamic_tyvar_RDR = mkSrcUnqual tvName dynamicName
unsafe_tyvar_RDR = mkSrcUnqual tvName unsafeName
stdcall_tyvar_RDR = mkSrcUnqual tvName stdcallName
ccall_tyvar_RDR = mkSrcUnqual tvName ccallName
minus_RDR = mkSrcUnqual varName SLIT("-")
pling_RDR = mkSrcUnqual varName SLIT("!")
......
{-
-----------------------------------------------------------------------------
<<<<<<< Parser.y
$Id: Parser.y,v 1.13 1999/07/27 09:25:49 simonmar Exp $
=======
$Id: Parser.y,v 1.13 1999/07/27 09:25:49 simonmar Exp $
>>>>>>> 1.10
$Id: Parser.y,v 1.14 1999/09/01 14:08:19 sof Exp $
Haskell grammar.
......@@ -97,6 +93,8 @@ Conflicts: 14 shift/reduce
'label' { ITlabel }
'dynamic' { ITdynamic }
'unsafe' { ITunsafe }
'stdcall' { ITstdcallconv }
'ccall' { ITccallconv }
'_ccall_' { ITccall (False, False, False) }
'_ccall_GC_' { ITccall (False, False, True) }
'_casm_' { ITccall (False, True, False) }
......@@ -348,13 +346,13 @@ topdecl :: { RdrBinding }
| srcloc 'foreign' 'import' callconv ext_name
unsafe_flag varid_no_unsafe '::' sigtype
{ RdrHsDecl (ForD (ForeignDecl $7 (FoImport $6) $9 $5 $4 $1)) }
{ RdrHsDecl (ForD (ForeignDecl $7 (FoImport $6) $9 (mkExtName $5 $7) $4 $1)) }
| srcloc 'foreign' 'export' callconv ext_name varid '::' sigtype
{ RdrHsDecl (ForD (ForeignDecl $6 FoExport $8 $5 $4 $1)) }
{ RdrHsDecl (ForD (ForeignDecl $6 FoExport $8 (mkExtName $5 $6) $4 $1)) }
| srcloc 'foreign' 'label' ext_name varid '::' sigtype
{ RdrHsDecl (ForD (ForeignDecl $5 FoLabel $7 $4
{ RdrHsDecl (ForD (ForeignDecl $5 FoLabel $7 (mkExtName $4 $5)
defaultCallConv $1)) }
| decl { $1 }
......@@ -455,17 +453,19 @@ rule_var :: { RdrNameRuleBndr }
-- Foreign import/export
callconv :: { Int }
: VARID {% checkCallConv $1 }
: 'stdcall' { stdCallConv }
| 'ccall' { cCallConv }
| {- empty -} { defaultCallConv }
unsafe_flag :: { Bool }
: 'unsafe' { True }
| {- empty -} { False }
ext_name :: { ExtName }
: 'dynamic' { Dynamic }
| STRING { ExtName $1 Nothing }
| STRING STRING { ExtName $2 (Just $1) }
ext_name :: { Maybe ExtName }
: 'dynamic' { Just Dynamic }
| STRING { Just (ExtName $1 Nothing) }
| STRING STRING { Just (ExtName $2 (Just $1)) }
| {- empty -} { Nothing }
-----------------------------------------------------------------------------
-- Types
......@@ -875,6 +875,8 @@ varid :: { RdrName }
| 'label' { label_var_RDR }
| 'dynamic' { dynamic_var_RDR }
| 'unsafe' { unsafe_var_RDR }
| 'stdcall' { stdcall_var_RDR }
| 'ccall' { ccall_var_RDR }
varid_no_unsafe :: { RdrName }
: VARID { mkSrcUnqual varName $1 }
......@@ -885,6 +887,8 @@ varid_no_unsafe :: { RdrName }
| 'export' { export_var_RDR }
| 'label' { label_var_RDR }
| 'dynamic' { dynamic_var_RDR }
| 'stdcall' { stdcall_var_RDR }
| 'ccall' { ccall_var_RDR }
-----------------------------------------------------------------------------
-- ConIds
......@@ -981,10 +985,12 @@ tyvar :: { RdrName }
| 'as' { as_tyvar_RDR }
| 'qualified' { qualified_tyvar_RDR }
| 'hiding' { hiding_tyvar_RDR }
| 'export' { export_var_RDR }
| 'label' { label_var_RDR }
| 'dynamic' { dynamic_var_RDR }
| 'unsafe' { unsafe_var_RDR }
| 'export' { export_tyvar_RDR }
| 'label' { label_tyvar_RDR }
| 'dynamic' { dynamic_tyvar_RDR }
| 'unsafe' { unsafe_tyvar_RDR }
| 'stdcall' { stdcall_tyvar_RDR }
| 'ccall' { ccall_tyvar_RDR }
-- NOTE: no 'forall'
-----------------------------------------------------------------------------
......
Markdown is supported
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