From ca8c38184c97ab7b8dd5a2540868d6b47536e72b Mon Sep 17 00:00:00 2001 From: andy Date: Thu, 9 Mar 2000 02:47:13 +0000 Subject: [PATCH] [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. --- ghc/interpreter/connect.h | 6 +++--- ghc/interpreter/input.c | 11 +++++++--- ghc/interpreter/link.c | 49 ++++++++++++++++++++++++++------------------- ghc/interpreter/parser.y | 11 ++++++++-- ghc/interpreter/static.c | 25 ++++++++++++++++++++--- 5 files changed, 70 insertions(+), 32 deletions(-) diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index d634c9d..73772e1 100644 --- 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 --- 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 --- 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 --- 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 --- 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 */ -- 1.7.10.4