* included in the distribution.
*
* $RCSfile: static.c,v $
- * $Revision: 1.31 $
- * $Date: 2000/03/22 18:14:23 $
+ * $Revision: 1.42 $
+ * $Date: 2000/06/02 16:19:47 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
#include "connect.h"
#include "errors.h"
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 );
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
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");
}
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;
}
}
} else {
- map2Accum(checkImportEntity,imports,m,priv,impList);
+ map1Accum(checkImportEntity,imports,m,impList);
}
return imports;
}
/* 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)) {
name(n).defn = nameId;
} else {
implementCfun(n,scs);
+ name(n).hasStrict = nonNull(scs);
}
hd(cs) = n;
}
}
+ /* add in the tyvars from the `supers' so that we don't
+ prematurely complain about undefined tyvars */
+ tyvars = typeVarsIn(cclass(c).supers,NIL,NIL,tyvars);
+
if (cclass(c).arity==0) {
cclass(c).head = c;
} else {
tcDeps = NIL; /* find dependents */
map2Over(depPredExp,cclass(c).line,tyvars,cclass(c).supers);
+
+ { /* depPredExp instantiates class names to class structs, so
+ * now we have enough info to check for ambiguity
+ */
+ List tvts = offsetTyvarsIn(cclass(c).head,NIL);
+ List tvps = offsetTyvarsIn(cclass(c).supers,NIL);
+ List fds = calcFunDeps(cclass(c).supers);
+ tvts = oclose(fds,tvts);
+ tvts = odiff(tvps,tvts);
+
+ if (!isNull(tvts)) {
+ ERRMSG(cclass(c).line) "Undefined type variable \"%s\"",
+ textToStr(textOf(nth(offsetOf(hd(tvts)),tyvars)))
+ EEND;
+ }
+ }
+
h98CheckCtxt(cclass(c).line,"class definition",FALSE,cclass(c).supers,NIL);
cclass(c).numSupers = length(cclass(c).supers);
cclass(c).defaults = extractBindings(cclass(c).members); /* defaults*/
thd3(m) = t; /* Save type */
take(cclass(c).arity,tyvars); /* Delete extra type vars */
- if (isAmbiguous(t)) {
- ambigError(line,"class declaration",hd(vs),t);
- }
h98CheckType(line,"member type",hd(vs),t);
}
Int line = intOf(fst3(m));
List vs = snd3(m);
Type t = thd3(m);
+
+ if (isAmbiguous(t)) {
+ ambigError(line,"class declaration",hd(vs),t);
+ }
}
static Void local addMembers(c) /* Add definitions of member funs */
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;
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;
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)) {
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.
#endif
Void checkDefns ( Module thisModule ) { /* Top level static analysis */
+ Text modName = module(thisModule).text;
staticAnalysis(RESET);
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);
projects / ghc-hetmet.git / blobdiff