[project @ 2000-04-21 14:40:48 by simonpj]
[ghc-hetmet.git] / ghc / interpreter / static.c
index e2cf438..16fad26 100644 (file)
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: static.c,v $
- * $Revision: 1.32 $
- * $Date: 2000/03/23 14:54:21 $
+ * $Revision: 1.40 $
+ * $Date: 2000/04/07 10:00:28 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -31,8 +31,8 @@ static List   local checkSubentities    ( List,List,List,String,Text );
 static List   local checkExportTycon    ( List,Text,Cell,Tycon );
 static List   local checkExportClass    ( List,Text,Cell,Class );
 static List   local checkExport         ( List,Text,Cell );
-static List   local checkImportEntity   ( List,Module,Bool,Cell );
-static List   local resolveImportList   ( Module,Cell,Bool );
+static List   local checkImportEntity   ( List,Module,Cell );
+static List   local resolveImportList   ( Module,Cell );
 static Void   local checkImportList     ( Pair );
 
 static Void   local importEntity        ( Module,Cell );
@@ -334,21 +334,14 @@ Text   textParent; {
     return imports;
 }
 
-static List local checkImportEntity(imports,exporter,priv,entity)
+static List local checkImportEntity(imports,exporter,entity)
 List   imports; /* Accumulated list of things to import */
 Module exporter;
-Bool priv;
 Cell entity; { /* Entry from import list */
     List oldImports = imports;
     Text t  = isIdent(entity) ? textOf(entity) : textOf(fst(entity));
     List es = NIL;
-    if (priv) {
-      es = module(exporter).names;
-      es = dupOnto(module(exporter).tycons,es);
-      es = dupOnto(module(exporter).classes,es);
-    } else {
-      es = module(exporter).exports; 
-    }
+    es = module(exporter).exports; 
 
     for(; nonNull(es); es=tl(es)) {
         Cell e = hd(es); /* :: Entity
@@ -398,18 +391,6 @@ Cell entity; { /* Entry from import list */
             if (isIdent(entity) && name(e).text == t) {
                 imports = cons(e,imports);
             }
-        } else if (isTycon(e) && priv) {
-           if (tycon(e).text == t) {
-               imports = cons(e,imports);
-               return dupOnto(tycon(e).defn,imports);
-           }
-        } else if (isClass(e) && priv) {
-           if (cclass(e).text == t) {
-               imports = cons(e,imports);
-               return dupOnto(cclass(e).members,imports);
-           }
-        } else if (whatIs(e) == TUPLE && priv) {
-         // do nothing
         } else {
             internal("checkImportEntity3");
         }
@@ -423,10 +404,9 @@ Cell entity; { /* Entry from import list */
     return imports;
 }
 
-static List local resolveImportList(m,impList,priv)
+static List local resolveImportList(m,impList)
 Module m;  /* exporting module */
-Cell impList; 
-Bool priv; {
+Cell impList; {
     List imports = NIL;
     if (DOTDOT == impList) {
         List es = module(m).exports;
@@ -450,7 +430,7 @@ Bool priv; {
             }
         }
     } else {
-        map2Accum(checkImportEntity,imports,m,priv,impList);
+        map1Accum(checkImportEntity,imports,m,impList);
     }
     return imports;
 }
@@ -467,15 +447,10 @@ Pair importSpec; {
         /* Somewhat inefficient - but obviously correct:
          * imports = importsOf("module Foo") `setDifference` hidden;
          */
-        hidden  = resolveImportList(m, snd(impList),FALSE);
-        imports = resolveImportList(m, DOTDOT,FALSE);
-    } else if (isPair(impList) && STAR == fst(impList)) {
-      List privileged;
-      imports = resolveImportList(m, DOTDOT, FALSE);
-      privileged = resolveImportList(m, snd(impList),TRUE);
-      imports = dupOnto(privileged,imports);
+        hidden  = resolveImportList(m, snd(impList));
+        imports = resolveImportList(m, DOTDOT);
     } else {
-        imports = resolveImportList(m, impList,FALSE);
+        imports = resolveImportList(m, impList);
     }
 
     for(; nonNull(imports); imports=tl(imports)) {
@@ -1029,6 +1004,7 @@ Cell  cd; {                             /* definitions (w or w/o deriving) */
             name(n).defn = nameId;
         } else {
             implementCfun(n,scs);
+            name(n).hasStrict = nonNull(scs);
         }
 
         hd(cs) = n;
@@ -3287,15 +3263,14 @@ Cell intName;
 Cell type; {
     Text t = textOf(intName);
     Name n = findName(t);
-    Int  l = intOf(line);
 
     if (isNull(n)) {
         n = newName(t,NIL);
     } else if (name(n).defn!=PREDEFINED) {
-        ERRMSG(l) "Redeclaration of foreign \"%s\"", textToStr(t)
+        ERRMSG(line) "Redeclaration of foreign \"%s\"", textToStr(t)
         EEND;
     }
-    name(n).line     = l;
+    name(n).line     = line;
     name(n).defn     = extName;
     name(n).type     = type;
     name(n).callconv = callconv;
@@ -3325,15 +3300,14 @@ Cell intName;
 Cell type; {
     Text t = textOf(intName);
     Name n = findName(t);
-    Int  l = intOf(line);
 
     if (isNull(n)) {
         n = newName(t,NIL);
     } else if (name(n).defn!=PREDEFINED) {
-        ERRMSG(l) "Redeclaration of foreign \"%s\"", textToStr(t)
+        ERRMSG(line) "Redeclaration of foreign \"%s\"", textToStr(t)
         EEND;
     }
-    name(n).line     = l;
+    name(n).line     = line;
     name(n).defn     = NIL;  /* nothing to say */
     name(n).type     = type;
     name(n).callconv = callconv;
@@ -4510,7 +4484,7 @@ Cell g; {                              /* expression                       */
 static Cell local depExpr(line,e)      /* find dependents of expression    */
 Int  line;
 Cell e; {
-  //    Printf( "\n\n"); print(e,100); Printf("\n");
+  //Printf( "\n\n"); print(e,100); Printf("\n");
   //printExp(stdout,e);
     switch (whatIs(e)) {
 
@@ -4717,12 +4691,6 @@ Cell e; {
         EEND;
     }
 
-#if 0
-    what is this for??
-    if (!moduleThisScript(name(n).mod)) {
-        return n;
-    }
-#endif
     /* Later phases of the system cannot cope if we resolve references
      * to unprocessed objects too early.  This is the main reason that
      * we cannot cope with recursive modules at the moment.
@@ -5024,6 +4992,7 @@ Void checkContext(void) {         /* Top level static check on Expr  */
 #endif
 
 Void checkDefns ( Module thisModule ) { /* Top level static analysis       */
+    Text modName = module(thisModule).text;
 
     staticAnalysis(RESET);
 
@@ -5033,17 +5002,17 @@ Void checkDefns ( Module thisModule ) { /* Top level static analysis       */
     mapProc(checkQualImport,  module(thisModule).qualImports);
     mapProc(checkUnqualImport,unqualImports);
     /* Add "import Prelude" if there`s no explicit import */
-    if (thisModule!=modulePrelude
-        && isNull(cellAssoc(modulePrelude,unqualImports))
-        && isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
-        unqualImports = cons(pair(modulePrelude,DOTDOT),unqualImports);
+    if (modName == textPrelPrim || modName == textPrelude) {
+      /* Nothing. */
+    } else if (isNull(cellAssoc(modulePrelude,unqualImports))
+              && isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {
+      unqualImports = cons(pair(modulePrelude,DOTDOT),unqualImports);
     } else {
-        /* Every module (including the Prelude) implicitly contains 
-         * "import qualified Prelude" 
-         */
-        module(thisModule).qualImports
-           =cons(pair(mkCon(textPrelude),modulePrelude),
-                 module(thisModule).qualImports);
+      /* Every module implicitly contains "import qualified Prelude" 
+       */
+      module(thisModule).qualImports
+       =cons(pair(mkCon(textPrelude),modulePrelude),
+             module(thisModule).qualImports);
     }
     mapProc(checkImportList, unqualImports);