X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2Fhsparser.y;h=59d6f9d9ad64bd4868c7f8c3ff55210a2708cf1f;hb=123f2400f92ba0aaac34340b9276954bd2371743;hp=663777977cc5bb4b83f56d6557b81922c8212f08;hpb=132c92f70c00bb465cfd33178338287eb587a63c;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y
index 6637779..59d6f9d 100644
--- a/ghc/compiler/parser/hsparser.y
+++ b/ghc/compiler/parser/hsparser.y
@@ -161,7 +161,8 @@ BOOLEAN pat_check=TRUE;
 
 %token  SCC
 %token	CCALL		CCALL_GC	CASM		CASM_GC
-
+%token  EXPORT          UNSAFE          STDCALL		C_CALL  
+%token  PASCAL		FASTCALL	FOREIGN         DYNAMIC
 
 /**********************************************************************
 *                                                                     *
@@ -239,7 +240,8 @@ BOOLEAN pat_check=TRUE;
   		gdrhs gdpat valrhs
   		lampats	cexps gd
 
-%type <umaybe>  maybeexports impspec deriving
+%type <umaybe>  maybeexports impspec deriving 
+		ext_name
 
 %type <uliteral> lit_constant
 
@@ -261,10 +263,10 @@ BOOLEAN pat_check=TRUE;
 		qvar qcon qvarop qconop qop
 		qvark qconk qtycon qtycls
 		gcon gconk gtycon itycon qop1 qvarop1 
-		ename iname 
+		ename iname
 
 %type <ubinding>  topdecl topdecls letdecls
-		  typed datad newtd classd instd defaultd
+		  typed datad newtd classd instd defaultd foreignd
 		  decl decls valdef instdef instdefs
  		  maybe_where cbody rinst type_and_maybe_id
 
@@ -284,6 +286,7 @@ BOOLEAN pat_check=TRUE;
 %type <uentid>	  export import
 
 %type <ulong>     commas importkey get_line_no
+		  unsafe_flag callconv
 
 /**********************************************************************
 *                                                                     *
@@ -482,6 +485,7 @@ topdecl	:  typed				{ $$ = $1; FN = NULL; SAMEFN = 0; }
 	|  classd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
 	|  instd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
 	|  defaultd 				{ $$ = $1; FN = NULL; SAMEFN = 0; }
+	|  foreignd				{ $$ = $1; FN = NULL; SAMEFN = 0; }
 	|  decl 				{ $$ = $1; }
 	;
 
@@ -540,6 +544,27 @@ defaultd:  defaultkey OPAREN types CPAREN       { $$ = mkdbind($3,startlineno);
 	|  defaultkey OPAREN CPAREN		{ $$ = mkdbind(Lnil,startlineno); }
 	;
 
+/* FFI primitive declarations - GHC/Hugs specific */
+foreignd:  foreignkey IMPORT callconv ext_name unsafe_flag qvarid DCOLON sigtype { $$ = mkfobind($6,$8,$4,$5,$3,FOREIGN_IMPORT,startlineno); }
+        |  foreignkey EXPORT callconv ext_name qvarid DCOLON sigtype             { $$ = mkfobind($5,$7,$4,0,$3,FOREIGN_EXPORT,startlineno); }
+	;
+
+callconv: STDCALL 	{ $$ = CALLCONV_STDCALL;  }
+	| C_CALL        { $$ = CALLCONV_CCALL;    }
+	| PASCAL        { $$ = CALLCONV_PASCAL;   }
+	| FASTCALL      { $$ = CALLCONV_FASTCALL; }
+	;
+
+ext_name: STRING	{ $$ = mkjust(lsing($1)); }
+	| STRING STRING { $$ = mkjust(mklcons ($1,lsing($2))); }
+        | DYNAMIC       { $$ = mknothing();   }
+
+unsafe_flag: UNSAFE	{ $$ = 1; }
+	   | /*empty*/  { $$ = 0; }
+	   ;
+
+
+
 decls	: decl
 	| decls SEMI decl
 		{
@@ -1431,6 +1456,9 @@ instkey	:   INSTANCE	{ setstartlineno();
 defaultkey: DEFAULT	{ setstartlineno(); }
 	;
 
+foreignkey: FOREIGN	         { setstartlineno();  }
+	  ;
+
 classkey:   CLASS	{ setstartlineno();
 			  if(etags)
 #if 1/*etags*/