[project @ 1998-08-14 12:07:18 by sof]

Front end changes to handle foreign declarations

diff --git a/ghc/compiler/parser/binding.ugn b/ghc/compiler/parser/binding.ugn
index 74c8a92..1d8e617 100644 (file)
--- a/ghc/compiler/parser/binding.ugn
+++ b/ghc/compiler/parser/binding.ugn
@@ -56,6 +56,17 @@ type binding;
                    gibindsource : long;
                    gibindline   : long; >;
 
+        /* FFI declarations */
+
+       fobind  : < gfobind_id   : qid;
+                   gfobind_ty   : ttype;
+                   gfobind_ext  : maybe;
+                   gfobind_flag : long;
+                   gfobind_cc   : long;
+                   gfobind_kind : long;
+                   gfobind_line : long; >;
+                   
+
        /* user-specified pragmas:XXXX */
 
        vspec_uprag : < gvspec_id   : qid;

diff --git a/ghc/compiler/parser/hschooks.c b/ghc/compiler/parser/hschooks.c
index 7fb06bb..5f848fe 100644 (file)
--- a/ghc/compiler/parser/hschooks.c
+++ b/ghc/compiler/parser/hschooks.c
@@ -5,15 +5,26 @@ in instead of the defaults.
 */
 #include <stdio.h>
 
+/* Included so as to bring the right prototypes into scope */
+#include "rtsdefs.h"
+
 #define W_ unsigned long int
 #define I_ long int
 
+#if __GLASGOW_HASKELL__ >= 303
+void
+ErrorHdrHook (long fd)
+{
+    char msg[]="\n";
+    write(fd,msg,1);
+}
+#else
 void
 ErrorHdrHook (FILE *where)
 {
     fprintf(where, "\n"); /* no "Fail: " */
 }
-
+#endif
 
 void
 OutOfHeapHook (W_ request_size, W_ heap_size)  /* both in bytes */
@@ -29,6 +40,31 @@ StackOverflowHook (I_ stack_size)    /* in bytes */
     fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
 }
 
+#if __GLASGOW_HASKELL__ >= 303
+void
+PatErrorHdrHook (long fd)
+{
+    const char msg[]="\n*** Pattern-matching error within GHC!\n\nThis is a compiler bug; please report it to glasgow-haskell-bugs@dcs.gla.ac.uk.\n\nFail:";
+    write(fd,msg,sizeof(msg)-1);
+}
+
+void
+PreTraceHook (long fd)
+{
+    const char msg[]="\n";
+    write(fd,msg,sizeof(msg)-1);
+}
+
+void
+PostTraceHook (long fd)
+{
+#if 0
+    const char msg[]="\n";
+    write(fd,msg,sizeof(msg)-1);
+#endif
+}
+
+#else
 void
 PatErrorHdrHook (FILE *where)
 {
@@ -46,3 +82,4 @@ PostTraceHook (FILE *where)
 {
     fprintf(where, "\n"); /* not "Trace Off" */
 }
+#endif

diff --git a/ghc/compiler/parser/hslexer.flex b/ghc/compiler/parser/hslexer.flex
index a3abd5a..a5adef3 100644 (file)
--- a/ghc/compiler/parser/hslexer.flex
+++ b/ghc/compiler/parser/hslexer.flex
@@ -399,6 +399,14 @@ NL                         [\n\r]
 <GlaExt>"_ccall_GC_"           { RETURN(CCALL_GC); }
 <GlaExt>"_casm_"               { RETURN(CASM); }
 <GlaExt>"_casm_GC_"            { RETURN(CASM_GC); }
+<GlaExt>"foreign"              { RETURN(FOREIGN); }
+<GlaExt>"export"               { RETURN(EXPORT); }
+<GlaExt>"unsafe"               { RETURN(UNSAFE); }
+<GlaExt>"_stdcall"             { RETURN(STDCALL); }
+<GlaExt>"_ccall"               { RETURN(C_CALL); }
+<GlaExt>"_pascal"              { RETURN(PASCAL); }
+<GlaExt>"_fastcall"            { RETURN(FASTCALL); }
+<GlaExt>"dynamic"              { RETURN(DYNAMIC); }
 
 %{
     /* 

diff --git a/ghc/compiler/parser/hsparser.y b/ghc/compiler/parser/hsparser.y
index 6637779..59d6f9d 100644 (file)
--- 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*/

diff --git a/ghc/compiler/parser/utils.h b/ghc/compiler/parser/utils.h
index 95389ec..8124440 100644 (file)
--- a/ghc/compiler/parser/utils.h
+++ b/ghc/compiler/parser/utils.h
@@ -114,6 +114,15 @@ void       precparse PROTO((tree));
 void   checkprec PROTO((tree, qid, BOOLEAN));
 */
 
+/* FFI predefines */
+#define CALLCONV_STDCALL  0
+#define CALLCONV_CCALL    1
+#define CALLCONV_PASCAL   2
+#define CALLCONV_FASTCALL 3
+
+#define FOREIGN_IMPORT    0
+#define FOREIGN_EXPORT    1
+
 BOOLEAN        isconstr PROTO((char *));
 void   setstartlineno PROTO((void));