[project @ 2000-03-09 02:47:13 by andy]

Changing name of linkPreludeNames to linkPrimitiveNames (cause that
is what it does).

Adding a Hugs extension "import privileged". This will allow us
to remove the many exports from the prelude of the primitive functions
and types, but still allow us to write libraries that use it.

diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h
index d634c9d..73772e1 100644 (file)
--- a/ghc/interpreter/connect.h
+++ b/ghc/interpreter/connect.h
@@ -8,8 +8,8 @@
  * included in the distribution.
  *
  * $RCSfile: connect.h,v $
- * $Revision: 1.23 $
- * $Date: 2000/01/07 16:56:47 $
+ * $Revision: 1.24 $
+ * $Date: 2000/03/09 02:47:13 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
@@ -522,7 +522,7 @@ extern  Void   translateControl Args((Int));
 extern  Void   codegen          Args((Int));
 extern  Void   machdep          Args((Int));
 
-extern Void linkPreludeNames(void);
+extern Void linkPrimitiveNames(void);
 
 extern  Kind  starToStar;                /* Type -> Type                    */
 extern Type  boundPair;                 /* (mkOffset(0),mkOffset(0))       */

diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c
index 0bbc280..de05f5f 100644 (file)
--- a/ghc/interpreter/input.c
+++ b/ghc/interpreter/input.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: input.c,v $
- * $Revision: 1.18 $
- * $Date: 1999/12/10 15:59:45 $
+ * $Revision: 1.19 $
+ * $Date: 2000/03/09 02:47:13 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -145,7 +145,7 @@ static Text textBang,    textDot,      textAll,    textImplies;
 static Text textWildcard;
 
 static Text textModule,  textImport,    textInterface,  textInstImport;
-static Text textHiding,  textQualified, textAsMod;
+static Text textHiding,  textQualified, textAsMod,      textPrivileged;
 static Text textExport,  textDynamic,   textUUExport;
 static Text textUnsafe,  textUUAll,     textUUUsage;
 
@@ -166,6 +166,7 @@ static Cell varDot;                     /* (.)                             */
 static Cell varHiding;                  /* hiding                          */
 static Cell varQualified;               /* qualified                       */
 static Cell varAsMod;                   /* as                              */
+static Cell varPrivileged;              /* privileged                      */
 
 static List imps;                       /* List of imports to be chased    */
 
@@ -1520,6 +1521,7 @@ static Int local yylex() {             /* Read next input token ...        */
         if (it==textHiding)            return HIDING;
         if (it==textQualified)         return QUALIFIED;
         if (it==textAsMod)             return ASMOD;
+        if (it==textPrivileged)        return PRIVILEGED;
         if (it==textWildcard)          return '_';
         if (it==textAll && !haskell98) return ALL;
 #if IPARAM
@@ -1749,6 +1751,7 @@ Int what; {
                        textHiding     = findText("hiding");
                        textQualified  = findText("qualified");
                        textAsMod      = findText("as");
+                       textPrivileged = findText("privileged");
                        textWildcard   = findText("_");
                        textAll        = findText("forall");
                        textUUAll      = findText("__forall");
@@ -1760,6 +1763,7 @@ Int what; {
                        varHiding      = mkVar(textHiding);
                        varQualified   = mkVar(textQualified);
                        varAsMod       = mkVar(textAsMod);
+                       varPrivileged  = mkVar(textPrivileged);
                        conMain        = mkCon(findText("Main"));
                        varMain        = mkVar(findText("main"));
                        evalDefaults   = NIL;
@@ -1808,6 +1812,7 @@ Int what; {
                        mark(varHiding);
                        mark(varQualified);
                        mark(varAsMod);
+                       mark(varPrivileged);
                        mark(varMain);
                        mark(conMain);
                        mark(imps);

diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c
index 956ff99..90e92da 100644 (file)
--- a/ghc/interpreter/link.c
+++ b/ghc/interpreter/link.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: link.c,v $
- * $Revision: 1.46 $
- * $Date: 2000/03/07 06:24:23 $
+ * $Revision: 1.47 $
+ * $Date: 2000/03/09 02:47:13 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -273,7 +273,7 @@ static Name predefinePrim ( String s )
  * 
  * ------------------------------------------------------------------------*/
 
-/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPreludeNames
+/* In standalone mode, linkPreludeTC, linkPreludeCM and linkPrimitiveNames
    are called, in that order, during static analysis of Prelude.hs.
    In combined mode such an analysis does not happen.  Instead these
    calls will be made as a result of a call link(POSTPREL).
@@ -436,10 +436,10 @@ Void linkPreludeCM(void) {              /* Hook to cfuns and mfuns in      */
     }
 }
 
-Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
+Void linkPrimitiveNames(void) {        /* Hook to names defined in Prelude */
     static Bool initialised = FALSE;
+
     if (!initialised) {
-        Int i;
         initialised = TRUE;
 
         setCurrModule(modulePrelude);
@@ -448,22 +448,29 @@ Void linkPreludeNames(void) {           /* Hook to names defined in Prelude */
         nameMkIO           = linkName("hugsprimMkIO");
 
         if (!combined) {
-           for (i=0; asmPrimOps[i].name; ++i) {
-               Text t = findText(asmPrimOps[i].name);
-               Name n = findName(t);
-               if (isNull(n)) {
-                   n = newName(t,NIL);
-               }
-               name(n).line   = 0;
-               name(n).defn   = NIL;
-               name(n).type   = primType(asmPrimOps[i].monad,
-                                         asmPrimOps[i].args,
-                                         asmPrimOps[i].results);
-               name(n).arity  = strlen(asmPrimOps[i].args);
-               name(n).primop = &(asmPrimOps[i]);
-               implementPrim(n);
-           }
+         Int i;
+         for (i=0; asmPrimOps[i].name; ++i) {
+           Text t = findText(asmPrimOps[i].name);
+           Name n = findName(t);
+           if (isNull(n)) {
+             n = newName(t,NIL);
+             name(n).line   = 0;
+             name(n).defn   = NIL;
+             name(n).type   = primType(asmPrimOps[i].monad,
+                                       asmPrimOps[i].args,
+                                       asmPrimOps[i].results);
+             name(n).arity  = strlen(asmPrimOps[i].args);
+             name(n).primop = &(asmPrimOps[i]);
+             implementPrim(n);
+           } else {
+             ERRMSG(0) "Link Error in Prelude, surplus definition of \"%s\"", 
+                               asmPrimOps[i].name
+              EEND;          
+             // Name already defined!
+           }
+         }
         }
+
         /* static(tidyInfix)                        */
         nameNegate         = linkName("negate");
         /* user interface                           */
@@ -524,7 +531,7 @@ Int what; {
            setCurrModule(modulePrelude);
            linkPreludeTC();
            linkPreludeCM();
-           linkPreludeNames();
+           linkPrimitiveNames();
 
            nameUnpackString = linkName("hugsprimUnpackString");
            namePMFail       = linkName("hugsprimPmFail");

diff --git a/ghc/interpreter/parser.y b/ghc/interpreter/parser.y
index fd465e4..dc8251c 100644 (file)
--- a/ghc/interpreter/parser.y
+++ b/ghc/interpreter/parser.y
@@ -12,8 +12,8 @@
  * included in the distribution.
  *
  * $RCSfile: parser.y,v $
- * $Revision: 1.22 $
- * $Date: 2000/02/08 15:32:30 $
+ * $Revision: 1.23 $
+ * $Date: 2000/03/09 02:47:13 $
  * ------------------------------------------------------------------------*/
 
 %{
@@ -98,6 +98,7 @@ static Void   local noIP       Args((String));
 %token EXPORT     UUEXPORT   INTERFACE  REQUIRES   UNSAFE     
 %token INSTIMPORT DYNAMIC    CCALL      STDKALL
 %token UTL        UTR        UUUSAGE
+%token PRIVILEGED
 
 %%
 /*- Top level script/module structure -------------------------------------*/
@@ -528,6 +529,9 @@ impDecl   : IMPORT modid impspec        {addQualImport($2,$2);
           | IMPORT QUALIFIED modid impspec
                                         {addQualImport($3,$3);
                                          $$ = gc4($3);}
+          | IMPORT PRIVILEGED modid     {addQualImport($3,$3);
+                                         addUnqualImport($3,gc0(STAR));
+                                        $$ = gc4($3);}
           | IMPORT error                {syntaxError("import declaration");}
           ;
 impspec   : /* empty */                 {$$ = gc0(DOTDOT);}
@@ -1201,6 +1205,7 @@ varid     : VARID                       {$$ = $1;}
           | HIDING                      {$$ = gc1(varHiding);}
           | QUALIFIED                   {$$ = gc1(varQualified);}
           | ASMOD                       {$$ = gc1(varAsMod);}
+          | PRIVILEGED                  {$$ = gc1(varPrivileged);}
           ;
 qconid    : QCONID                      {$$ = $1;}
           | CONID                       {$$ = $1;}
@@ -1269,6 +1274,7 @@ varid1    : VARID                       {$$ = gc1($1);}
           | HIDING                      {$$ = gc1(varHiding);}
           | QUALIFIED                   {$$ = gc1(varQualified);}
           | ASMOD                       {$$ = gc1(varAsMod);}
+          | PRIVILEGED                  {$$ = gc1(varPrivileged);}
           ;
 
 /*- Tricks to force insertion of leading and closing braces ---------------*/
@@ -1413,6 +1419,7 @@ static String local unexpected() {     /* find name for unexpected token   */
                          return buffer;
         case HIDING    : return "symbol \"hiding\"";
         case QUALIFIED : return "symbol \"qualified\"";
+       case PRIVILEGED : return "symbol \"privileged\"";
         case ASMOD     : return "symbol \"as\"";
         case NUMLIT    : return "numeric literal";
         case CHARLIT   : return "character literal";

diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c
index 46af0ac..4797250 100644 (file)
--- a/ghc/interpreter/static.c
+++ b/ghc/interpreter/static.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: static.c,v $
- * $Revision: 1.24 $
- * $Date: 2000/03/06 08:38:04 $
+ * $Revision: 1.25 $
+ * $Date: 2000/03/09 02:47:13 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -441,6 +441,25 @@ Cell   impList; {
                 }
             }
         }
+    } else if (STAR == impList) {
+      List xs;
+      for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
+       Cell e = hd(xs);
+       imports = cons(e,imports);
+      }
+      for(xs=module(m).classes; nonNull(xs); xs=tl(xs)) {
+       Cell cl = hd(xs);
+       imports = cons(cl,imports);
+       imports = dupOnto(cclass(cl).members,imports);
+      }
+      for(xs=module(m).tycons; nonNull(xs); xs=tl(xs)) {
+       Cell t = hd(xs);
+       imports = cons(t,imports);
+       if (isTycon(t)
+           && (tycon(t).what == DATATYPE 
+               || tycon(t).what == NEWTYPE))
+         imports = dupOnto(tycon(t).defn,imports);
+      }
     } else {
         map1Accum(checkImportEntity,imports,m,impList);
     }
@@ -5070,7 +5089,7 @@ Void checkDefns() {                     /* Top level static analysis       */
 
     mapProc(allNoPrevDef,valDefns);     /* check against previous defns    */
 
-    if (!combined) linkPreludeNames();  /* link names in Prelude           */
+    if (!combined) linkPrimitiveNames(); /* link primitive names           */
 
     mapProc(checkForeignImport,foreignImports); /* check foreign imports   */
     mapProc(checkForeignExport,foreignExports); /* check foreign exports   */