/* -------------------------------------------------------------------------- * Haskell 98 module system implementation for Hugs. * * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the * Yale Haskell Group, and the OGI School of Science & Engineering at OHSU, * 1994-2003, All rights reserved.  It is distributed as free software under * the license in the file "License", which is included in the distribution. * * -sof 2002. *  * ------------------------------------------------------------------------*/#include "prelude.h"#include "storage.h"#include "connect.h"#include "errors.h"#include "module.h"#include "output.h" /* -------------------------------------------------------------------------- * Static analysis of modules: * * The static checks of the import and export lists are invoked * via the entry points in module.h  (cf. static.c:checkDefns()). * * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- * local function prototypes: * ------------------------------------------------------------------------*/static Name   local lookupName		Args((Text,List));static Module local modOfEntity         Args((Cell));static Void   local reportAmbigEntity   Args((Text,Text,List));static List   local checkSubentities	Args((List,List,List,String,Text));static Void   local checkExportDistinct Args((List,Bool,Cell));static List   local checkExportTycon	Args((List,Text,Bool,Cell,Tycon));static List   local checkExportClass	Args((List,Text,Bool,Cell,Class));static List   local checkExportModule	Args((List,Text,Cell));static List   local checkExport		Args((List,Text,Cell));static List   local checkImportEntity	Args((List,Module,Bool,Cell));static List   local resolveImportList	Args((Module,Cell,Bool));static Cell   local entityIsMember      Args((Cell,List));static List   local augmentEntity       Args((Bool,Cell,Cell,List));static List   local addEntity           Args((Cell,Cell,List));static List   local addEntityPair       Args((Cell,List));static List   local mergeImportLists    Args((List,List));static List   local getIEOrphans        Args((List));static List   local fixupIEList         Args((List));static List   local allMethodsOrDCons   Args((List,Cell,Module,Bool)); static Cell   local importEntity	Args((Module,Cell));static Void   local importTycon		Args((Module,Tycon));static Void   local importClass		Args((Module,Class)); static Void   local browseName		Args((Name));static Void   local browseEntity	Args((Cell)); Void addQualImport(orig,new,entities) /* Add to qualified import list       */Cell orig;       /* Original name of module                                */Cell new;        /* Name module is called within this module (or NIL)      */List entities; { /* List of entity names */    /* Record the entities imported */    module(currentModule).qualImports =       addEntity(orig,entities,module(currentModule).qualImports);    /* Record the module --> alias mapping */    module(currentModule).modAliases =        cons(pair(isNull(new)?orig:new,orig), module(currentModule).modAliases);} Void addUnqualImport(mod,new,entities) /* An unqualified import            */Cell mod;         /* Name of module                                        */Cell new;         /* Local alias                                           */List entities;  { /* List of entity names                                  */    /* Add to unqualified import list */    unqualImports = addEntity(mod,entities,unqualImports);    /* Record the module --> alias mapping */    module(currentModule).modAliases =        cons(pair(isNull(new)?mod:new,mod), module(currentModule).modAliases);}  static Name local lookupName(t,nms)    /* find text t in list of Names     */Text t;List nms; { /* :: [Name] */    for(; nonNull(nms); nms=tl(nms)) {      if ( t == name(hd(nms)).text ) {	    return hd(nms);      }    }    return NIL;} static List local checkSubentities(imports,named,wanted,description,textParent)List   imports;List   named;       /* :: [ Q?(Var|Con)(Id|Op) ]                  */List   wanted;      /* :: [Name]                                  */String description; /* "<constructor>|<member> of <type>|<class>" */Text   textParent; {    for(; nonNull(named); named=tl(named)) {	Pair x = hd(named);	/* ToDo: ignores qualifier; doesn't check that entity is in scope */	Text t = isPair(snd(x)) ? qtextOf(x) : textOf(x);	Name n = lookupName(t,wanted);	if (isNull(n)) {	    ERRMSG(0) "Entity \"%s\" is not a %s \"%s\"",		      textToStr(t),		      description,		      textToStr(textParent)	    EEND;	}	imports = cons(n,imports);    }    return imports;} #if 0/* debugging code - dumping IE lists */static Void showIEEntity Args((Cell));static Void showIEList   Args((List,char)); static VoidshowIEEntity(e)Cell e; {  if (isName(e)) {    fprintf(stderr, "%s", textToStr(name(e).text));  } else if (isClass(e)) {    fprintf(stderr, "%s", textToStr(cclass(e).text));  } else if (isTycon(e)) {    fprintf(stderr, "%s", textToStr(tycon(e).text));  } else if (isPair(e)) {    showIEEntity(fst(e));    fprintf(stderr, "(");    showIEList(snd(e),' ');    fprintf(stderr, ")");  } else {    fprintf(stderr, "showIEEntity: unknown entity kind %d\n", whatIs(e));    fflush(stderr);  }} static VoidshowIEList(ieList,sep)List ieList;char sep; {  List xs = ieList;  for(;nonNull(xs);xs=tl(xs)) {    showIEEntity(hd(xs));    if (tl(xs) != NIL) {      fputc(sep, stderr);    }  }}#endif static List getIEOrphans(ieList) /* locate methods/dcons appearing on their */List ieList; {                   /* own in an import/export list.           */  List orphans = NIL;  List xs;    for(xs=ieList;nonNull(xs);xs=tl(xs)) {    Cell e = hd(xs);    if ( isName(e) ) {      if (isClass(name(e).parent)) {	/* a lone member */	orphans = cons(pair(name(e).parent, singleton(e)), orphans);      } else if (isCfun(e)) {	/* a lone data constructor (can only appear in a hiding list.) */	orphans = cons(pair(name(e).parent, singleton(e)), orphans);      } else if (isSfun(e)) {	/* a field name */	Cell p = name(e).parent;      /* the data constructor */	Cell t = name(p).parent;      /* the type constructor */	orphans = cons(pair(t,singleton(e)), orphans);      }    }  }  return orphans;} /* * fixupIEList() traverses an import/export list, adjusting * the list in the following ways: * *  1. 'orphan'/subordinate names are joined up with their *     parents. An orphan E is either a class member, field *     name or a data constructor (in 'hiding' lists *only*) *     that's imported/exported without referring to its *     parent P -- E appears in an import/export list rather *     than P(E). If P is appearing elsewhere in the *     import/export list, float E inside of P. * * ToDo: remove duplicates from the resulting list also; it's *       harmless for there to be any, but may lead to confusion *       later on. *  */static List fixupIEList(ieList)List ieList; {  List orphans = NIL;  List xs;   orphans = getIEOrphans(ieList);    if (nonNull(orphans)) {#if 0    /* Debugging - show the orphan list */    fprintf(stderr, "Orphan list{%s}:", textToStr(module(currentModule).text)); fflush(stderr);    showIEList(orphans,'\n'); fflush(stderr);#endif    /* Transformation 1 (we're actually being a bit sloppy here       and not removing the orphan from the IE list if it       can be floated inside its parent.) */    for(xs=orphans; nonNull(xs);xs=tl(xs)) {      ieList = augmentEntity(FALSE,fst(hd(xs)),snd(hd(xs)),ieList);    }  }  return ieList;}           Void fixupImportExports (ls)List ls; {    List xs;    for(xs=ls;nonNull(xs);xs=tl(xs)) {      if ( isPair(hd(xs)) && !fst(snd(hd(xs))) ) {        snd(snd(hd(xs))) = fixupIEList(snd(snd(hd(xs))));      }    }} static List local checkImportEntity(imports,exporter,isHidden,entity)List   imports; /* Accumulated list of things to import */Module exporter;Bool   isHidden;Cell   entity; { /* Entry from import/hiding list */    Bool impFound    = FALSE;    Bool isId        = isIdent(entity);    Cell subEntities = !isId ? snd(entity) : NIL;    Text t           = isId ? textOf(entity) : textOf(fst(entity));    List es          = module(exporter).exports;    Bool lookForVar  = isVar(entity);     /* In H98, a data con may be named in a 'hiding' list, so we     * have to grovel around inside each tycon looking for it.     */    Bool lookForDataCon =       isHidden &&      subEntities == NONE &&       isCon(isId ? entity : fst(entity));          /* The use of NONE heralds a dcon */    subEntities = ( (subEntities == NONE) ? NIL : subEntities);        for(; nonNull(es); es=tl(es)) {	Cell e = hd(es); /* :: Entity | (Entity, NIL|DOTDOT|[Entity]) */	if (isPair(e)) {	    Cell f = fst(e);	    if (isTycon(f)) {		if (tycon(f).text == t) {		    impFound = TRUE;		    if (!isId) {			switch (tycon(f).what) {			case NEWTYPE:			case DATATYPE:			    if (DOTDOT == subEntities) {				/* Want all dcons that are _exported_ by				   the importing module.				*/				Cell dcons;				if (snd(e) == DOTDOT) {				    dcons = tycon(f).defn;				} else {				    dcons = snd(e);				}				imports=addEntity(f,dcons,imports);			    } else if ( NIL == subEntities) {				imports=addEntity(f,NIL,imports);			    } else {				List xs = NIL;				xs = checkSubentities(xs, subEntities, tycon(f).defn,"constructor of type",t);				imports=addEntity(f,xs,imports);			    }			    break;			case SYNONYM:			case RESTRICTSYN:			    imports=addEntity(f,DOTDOT,imports);			    break;			default:;			  /* deliberate fall thru */			    }		    } else {			imports = addEntity(f,NIL,imports);		    }		    if (!lookForDataCon) break;		}		/* check the data constructors or field labels for match */		if (tycon(f).what != SYNONYM     && 		    tycon(f).what != RESTRICTSYN &&		    (lookForVar || lookForDataCon)) {		    /* The type's exported dcons/fields */		    Cell dcons;		    if (snd(e) == DOTDOT) {			dcons = tycon(f).defn;		    } else {			dcons = snd(e);		    }		    while(nonNull(dcons)) {			if (isName(hd(dcons)) && name(hd(dcons)).text == t) {			    impFound = TRUE;			    imports=addEntity(hd(dcons),NIL,imports);			    break;			}			dcons=tl(dcons);		    }		}	    } else if (isClass(f)) {		List sigs = NIL;		/* Want all members that are _exported_ by the importing module. */		if (isPair(e)) {		    if (snd(e) == DOTDOT) {			sigs = cclass(f).members;		    } else {			sigs = snd(e);		    }		}		if (cclass(f).text == t) {		    impFound = TRUE;		    if (!isId) {			if (DOTDOT == subEntities) {			    imports=addEntity(f,sigs,imports);			    return imports;			} else if ( NIL == subEntities) {			    imports=addEntity(f,NIL,imports);			} else {			    List xs = NIL;			    xs = checkSubentities(xs, subEntities, cclass(f).members,"member of class",t);			    imports=addEntity(f,xs,imports);			}		    }		    break;		}		if (!impFound && isId) {		    List xs = sigs;		    while(nonNull(xs)) {			if (isName(hd(xs)) && name(hd(xs)).text == t) {			    impFound = TRUE;			    imports=cons(hd(xs),imports);			    break;			}			xs=tl(xs);		    }		}	    } else {		internal("checkImportEntity2");	    }	} else if (isName(e)) {	    if (isId && name(e).text == t) {		impFound = TRUE;		imports=cons(e,imports);		if (!lookForDataCon) break;	    }	} else if (isTycon(e)) {	    if (isId && tycon(e).text == t) {		impFound = TRUE;		imports = addEntity(e,NIL,imports);		if (!lookForDataCon) break;	    }	} else {	    internal("checkImportEntity3");	}    }    if (!impFound) {	ERRMSG(0) "Unknown entity \"%s\" %s from module \"%s\"",                  textToStr(t), ((!isHidden) ? "imported" : "hidden"),		  textToStr(module(exporter ).text)	EEND;    }    return imports;} static List local resolveImportList(m,impList,isHidden)Module m;  /* exporting module */Cell   impList;Bool   isHidden; {    List imports = NIL;    if (DOTDOT == impList) {	List es = module(m).exports;	for(; nonNull(es); es=tl(es)) {	    Cell e = hd(es);	    if (isName(e)) {		imports = cons(e,imports);            } else {                Cell c = fst(e);                List subentities = NIL;                if ( isClass(c) ||                      (isTycon(c)                       && (tycon(c).what == DATATYPE ||                           tycon(c).what == NEWTYPE)) ) {                    if (snd(e) != DOTDOT) {                        List ys = snd(e);                        Name sub;                        while (nonNull(ys)) {                            if (isPair(hd(ys))) {                                if (nonNull(sub = findQualName(hd(ys)))) {                                  subentities = cons (sub,subentities);                                }                            } else {                                subentities = cons(hd(ys),subentities);                            }                            ys=tl(ys);                        }			subentities = rev(subentities);                    } else {                        if (isClass(c)) {                            subentities = cclass(c).members;                        } else {                            subentities = tycon(c).defn;                        }                    }                }                imports = addEntity(c,subentities,imports);            }        }	imports = rev(imports);    } else {        map2Accum(checkImportEntity,imports,m,isHidden,impList);    }    return imports;} Void checkQualImportList(importSpec)Pair importSpec; {  /* checkQualImport() has verified that the module has already been loaded;   * just locate the Module for it here & update the qualImports.   */  Module m = findModid(fst(importSpec));  fst(importSpec) = m;   checkImportList(TRUE,importSpec);} static List local addEntityPair(e,is) /* For pair (e,ls) add ls to the 'is' */                                      /* import/export list.                   */Cell e;List is; {  if (isPair(e)) {    return addEntity(fst(e),snd(e), is);  } else if (isName(e)) {      if (isClass(name(e).parent)) {        return addEntity(name(e).parent, singleton(e),is);      } else if (isTycon(name(e).parent) && isCfun(e)) {        return addEntity(name(e).parent, singleton(e),is);      } else if (isSfun(e)) {        /* a field name */        Cell p = name(e).parent;      /* the data constructor */        Cell t = name(p).parent;      /* the type constructor */        return addEntity(t, singleton(e), is);      }  }  return addEntity(e,NIL,is);} static List local augmentEntity(addNew,e,ls,is) Bool addNew;                      /* For entity e, add 'ls' to the 'is'   */Cell e;                           /* import/export list,combining it with */Cell ls;                          /* previous entries (if any.)           */List is; {     Cell ms = entityIsMember(e,is);        if (!ms) {      if (!addNew) {        return is;      } else {        if (isName(e) && (ls == NIL || ls == NONE)) {           return cons(e,is);        } else {            return cons(pair(e,ls),is);        }      }    } else {        /* concat the two lists; remove duplicates. */        if (!isPair(hd(ms)) && ls != NIL) {            hd(ms) = pair(e,ls);        } else if (ls == NIL || ls == NONE || snd(hd(ms)) == DOTDOT) {            ;        } else if (ls == DOTDOT || snd(hd(ms)) == NIL || snd(hd(ms)) == NONE) {            snd(hd(ms)) = ls;        } else {            snd(hd(ms)) = nubList(dupOnto(ls,snd(hd(ms))));        }        return is;    }} static List local addEntity(e,ls,is)Cell e;Cell ls;List is; {  return augmentEntity(TRUE,e,ls,is);} 

Lines 1–500 of 1260. Load more