[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.

ghc/compiler/parser/Lex.lhs

@@ -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)),

ghc/compiler/parser/ParseUtil.lhs

@@ -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("!")

ghc/compiler/parser/Parser.y

 {-
 -----------------------------------------------------------------------------
-<<<<<<< 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'
 
 -----------------------------------------------------------------------------