X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstatic.c;h=7636dd7f37d39753294ecc5774a0995343516313;hb=6151c960d6df040a5bfd94791f934969dfb55050;hp=612a57eb208d64ae19dc1f468171f9de81262c1c;hpb=039fce55118f6a18e5b5cba63ccdd0dfc341894d;p=ghc-hetmet.git diff --git a/ghc/interpreter/static.c b/ghc/interpreter/static.c index 612a57e..7636dd7 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.35 $ - * $Date: 2000/04/04 01:19:07 $ + * $Revision: 1.42 $ + * $Date: 2000/06/02 16:19:47 $ * ------------------------------------------------------------------------*/ #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,17 +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)) { - // Previously, I was forcing an import Prelude, - // but this precluded doing things like - // import Prelude hiding ( catch) - // so, for now, you need to put an explicit - // import Prelude if you use import privileged. - imports = resolveImportList(m, snd(impList),TRUE); + 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)) { @@ -1031,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; @@ -1348,6 +1322,10 @@ Class c; { } } + /* 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 { @@ -1361,6 +1339,23 @@ Class c; { 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*/ @@ -1541,9 +1536,6 @@ Cell m; { 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); } @@ -1553,6 +1545,10 @@ Cell m; { 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 */ @@ -3289,15 +3285,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; @@ -3327,15 +3322,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; @@ -4719,12 +4713,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. @@ -5036,7 +5024,7 @@ 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 (modName == textPrimPrel || modName == textPrelude) { + if (modName == textPrelPrim || modName == textPrelude) { /* Nothing. */ } else if (isNull(cellAssoc(modulePrelude,unqualImports)) && isNull(cellRevAssoc(modulePrelude,module(thisModule).qualImports))) {