text: /* --------------------------------------------------------------------------
   * 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 Void
  showIEEntity(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 Void
  showIEList(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);
  }
  
  static Cell local entityIsMember(x,xs) /* Test for membership of specific  */
  Cell x;                                /* entity x in import/export list xs  */
  List xs; {
      for (; nonNull(xs); xs=tl(xs)) {
          if (x == hd(xs))
              return xs;
          if (isPair (hd(xs)) && x==fst(hd(xs)))
              return xs;
      }
      return NIL;
  }
  
  static List local mergeImportLists(ls1,ls2)
  List ls1;
  List ls2; {
    List xs;
  
    for (xs=ls1;nonNull(xs);xs=tl(xs)) {
        ls2 = addEntityPair(hd(xs),ls2);
    }
    return ls2;
  }
  
  Void checkImportList(isQual,importSpec) /*Import a module (un)qualified*/
  Bool isQual;
  Pair importSpec; {
      Module m       = fst(importSpec);
      Cell   impList = snd(importSpec);
  
      List   imports = NIL; /* entities we want to import */
      List   hidden  = NIL; /* entities we want to hide   */
  
      List   modImps = NIL; /* The effective import list */
      List   es = NIL;
      Bool   isHidden = (isPair(impList) && HIDDEN == fst(impList));
  
      if (!isQual && moduleThisScript(m)) { 
          ERRMSG(0) "Module \"%s\" recursively imports itself",
                    textToStr(module(m).text)
          EEND;
      }
      if ( isHidden ) {
          List orphans;
          /* Somewhat inefficient - but obviously correct:
           * imports = importsOf("module Foo") `setDifference` hidden;
  	 */
          hidden  = fixupIEList(resolveImportList(m, snd(impList),TRUE));
  	imports = resolveImportList(m, DOTDOT,FALSE);
  	
  	/* Get the lone method/field/dcons that appear in the hiding list. */
  	orphans = getIEOrphans(hidden);
  	
  	/* remove them from their parents in the import list. */
  	for (;nonNull(orphans);orphans=tl(orphans)) {
  	  /* the 'hd.snd' is the orphan entity, 'fst' is its parent. */
  	  
  	  /* Locate and remove the sub-entity. */
  	  Cell ls = entityIsMember(fst(hd(orphans)), imports);
  	  if (ls && isPair(hd(ls))) {
  	    snd(hd(ls)) = removeCell(hd(snd(hd(orphans))), dupList(snd(hd(ls))));
  	  }
  	}
  
  	/* With the orphans in the 'hiding' list accounted for,
  	 * compute the effective import list by traversing over the
  	 * entire import list, checking whether any of the entities
  	 * do appear in the hiding list.
  	 */
  	for(; nonNull(imports); imports=tl(imports)) {
  	  Cell e = hd(imports);
  
  	  if (isPair(e)) {
  	    /* A tycon/class */
  	    Cell tc   = fst(e);
  	    Cell subs = snd(e);
  	    List ms = entityIsMember(tc,hidden);
  	    
  	    if (!ms) {
  	      /* not in the hiding list, add it to effective import list. */
  	      if (isQual) {
  		modImps = cons(pair(tc,subs),modImps);
  	      } else {
  		modImps = cons(importEntity(m,e), modImps);
  	      }
  	    } else if isPair(hd(ms)) {
  		/* The parent tycon/class is hidden, but perhaps
  		   not all of its subentities. */
  	        Cell ent = fst(hd(ms));
  		List hiddenSubs = snd(hd(ms));
  		Module impMod;
  		
  		/* Figure out what module the entity was imported from */
  		if ( isClass(ent) ) {
  		  impMod = cclass(ent).mod;
  		} else if ( isTycon(ent) ) {
  		  impMod = tycon(ent).mod;
  		} else {
  		  internal("checkImportList");
  		}
  		
  		for(;nonNull(subs);subs=tl(subs)) {
  		  if (!entityIsMember(hd(subs),hiddenSubs)) {
  		    /* Register the sub-entity as imported */
  		    if (!isQual)
  		      importName(impMod, hd(subs));
  		    modImps = cons(hd(subs), modImps);
  		  }
  		}
  	    }
  	  } else {
  	    if (!entityIsMember(e,hidden)) {
  	      if (isQual) {
  		modImps = cons(e, modImps);
  	      } else {
  		modImps = cons(importEntity(m,e), modImps);
  	      }
  	    }
  	  }
  	}
  	
      } else {  /* the more common case, no hidings. */
  	imports = resolveImportList(m, impList,FALSE);
  	if (isQual) {
  	  modImps = imports;
  	} else {
  	  for(; nonNull(imports); imports=tl(imports)) {
  	      modImps = addEntityPair(importEntity(m,hd(imports)), modImps);
  	  }
  	}
      }
      /* To be able to handle re-exportation of modules, each module
       * keeps track of the effective import list of all its imports,
       * so that we later on can constrain re-exportation to only
       * contain what was imported.
       */
  
      /* If there's more than one import decl for the same module,
       * combine the import lists.
       */
      for(es=module(currentModule).modImports;nonNull(es);es=tl(es)) {
        if (isPair(hd(es)) && fst(hd(es)) == m) {
  	fst(snd(hd(es))) = FALSE; /* => perform fixup at the end. */
  	snd(snd(hd(es))) = mergeImportLists(modImps, snd(snd(hd(es))));
  	break;
        }
      }
      if (isNull(es)) {
        /* Module not already present, add it. */
        module(currentModule).modImports = 
  	 cons(pair(m,pair(isHidden,modImps)),module(currentModule).modImports);
      }
  }
  
  static Cell local importEntity(source,e)
  Module source;
  Cell e; {
      Cell ent = e;
      Cell cs  = NIL;
  
      /* If a pair, then the snd component gives the
       * constructors/methods that are specifically imported
       * with the tycon/class.
       */
      if ( isPair(e) ) {
  	ent = fst(e);
  	cs  = snd(e);
      }
      if (cs != NIL && cs != DOTDOT) {
        List xs;
        for (xs=cs;nonNull(xs);xs=tl(xs)) {
  	importEntity(source,hd(xs));
        }
      }
      switch (whatIs(ent)) {
        case VARIDCELL  : 
        case VAROPCELL  : 
        case CONIDCELL  : 
        case CONOPCELL  : 
  	           importName(source,snd(ent));
  	           return e;
        case NAME  : 
  	           importName(source,ent); 
  	           return e;
        case TYCON : 
  	           importTycon(source,ent); 
  	           return pair(ent,cs);
        case CLASS : importClass(source,ent);
  	           return pair(ent,cs);
  		   
      default:   
                 internal("importEntity");
  	       return NIL;
      }
  }
  
  Void importName(source,n)
  Module source;
  Name n; {
      Name clash = addName(n);
      if (nonNull(clash) && clash!=n
  	/* 'n' contains a name imported from another module's
  	 * export list. Due to module re-exportation, its 'home
  	 * module' (i.e., the module where 'n' was actually declared)
  	 * may not be equal to that of the module we're now importing
  	 * from here ('source'.) So, we've only got a name clash if
  	 * the home module of 'n' is different from that of 'clash'.
  	 */
       && name(n).mod != name(clash).mod ) {
        name(clash).clashes = cons(n,name(clash).clashes);
      }
  }
  
  static Void local importTycon(source,tc)
  Module source;
  Tycon tc; {
      Tycon clash=addTycon(tc);
      Class cc;
      if (nonNull(clash) && clash!=tc
        /* See importName() comment. */
       && tycon(tc).mod != tycon(clash).mod ) {
        tycon(clash).clashes = cons(tc,tycon(clash).clashes);
      }
      if ( nonNull(cc = findClass(tycon(tc).text)) ) {
        cclass(cc).clashes = cons(tc,cclass(cc).clashes);
      }
  }
  
  static Void local importClass(source,c)
  Module source;
  Class c; {
      Class clash=addClass(c);
      if (nonNull(clash) && clash!=c
        /* See importName() comment. */
       && cclass(c).mod != cclass(clash).mod ) {
  	/* Hmm..don't quite understand why we need to record the clash
  	   on both the class values here..*/
          cclass(c).clashes = cons(clash,cclass(c).clashes);
          cclass(clash).clashes = cons(c,cclass(clash).clashes);
      }
      if (nonNull(findTycon(cclass(c).text))) {
          cclass(clash).clashes = cons(c,cclass(clash).clashes);
      }
  }
  
  static Module local modOfEntity(ent) /* get at the module of name/tycon/class */
  Cell ent; {
    if (isName(ent)) {
        return name(ent).mod;
    } else if (isTycon(ent)) {
        return tycon(ent).mod;
    } else if (isClass(ent)) {
        return cclass(ent).mod;
    }
    return NIL;
  }
  
  static Void local reportAmbigEntity(mt,t,clashes) 
  Text mt;
  Text t;
  List clashes; {
      if (nonNull(clashes)) {
  	/* Unqualified name is ambiguous, report this. */
  	Module m1;
  	ERRMSG(0) "Ambiguous export of entity \"%s\"",
  	    textToStr(t) ETHEN
  	    ERRTEXT "\n*** Could refer to: %s.%s ",
  	    textToStr(mt),
  	    textToStr(t) ETHEN
  	    for(;nonNull(clashes);clashes=tl(clashes)) {
  		m1 = modOfEntity(hd(clashes));
  		
  		if (m1) {
  		    ERRTEXT "%s.%s ", 
  			textToStr(module(m1).text),
  			textToStr(t)
  			ETHEN
  		}
  	    }
  	ERRTEXT "\n" EEND;
      }
  }
  
  /* verify that the entity is unique in unqualified form */
  static Void local checkExportDistinct(exports,ambigCheck,ent) 
  List exports;  
  Bool ambigCheck;
  Cell ent; {
    Name  clashNm;
    Tycon clashTc;
    Class clashCc;
    Module mod1,mod2;
    Text txt;
    Bool inConflict = FALSE;
    List clashes = NIL;
  
    if ( isName(ent) ) {
        clashes = name(ent).clashes;
        txt     = name(ent).text;
        mod1    = name(ent).mod;
  
        if ( (clashNm = nameInIEList(ent,exports)) &&
  	   (name(clashNm).mod != name(ent).mod) ) {
  	  mod2 = name(clashNm).mod;
  	  inConflict = TRUE;
        }
    } else if ( isTycon(ent) ) {
        clashes = tycon(ent).clashes;
        txt     = tycon(ent).text;
        mod1    = tycon(ent).mod;
        
        if ( (clashTc = tyconInIEList(tycon(ent).text,exports)) &&
  	   (tycon(clashTc).mod != tycon(ent).mod) ) {
  	  mod2 = tycon(clashTc).mod;
  	  inConflict = TRUE;
        }
    } else if ( isClass(ent) ) {
        clashes = cclass(ent).clashes;
        txt     = cclass(ent).text;
        mod1    = cclass(ent).mod;
        
        if ( (clashCc = classInIEList(cclass(ent).text,exports)) &&
  	   (cclass(clashCc).mod != cclass(ent).mod) ) {
  	  mod2 = cclass(clashCc).mod;
  	  inConflict = TRUE;
        }
    } else if (isPair(ent)) {
        List subs = NIL;
        checkExportDistinct(exports, ambigCheck, fst(ent));
        if (snd(ent) == DOTDOT) {
  	if (isTycon(fst(ent))) {
  	  if (tycon(fst(ent)).what == SYNONYM ||
  	      tycon(fst(ent)).what == RESTRICTSYN) {
  	    subs = NIL;
  	  } else {
  	    subs = tycon(fst(ent)).defn;
  	  }
  	} else if (isClass(fst(ent))) {
  	  subs = cclass(fst(ent)).members;
  	} 
        } else {
  	subs = snd(ent);
        }
        map2Proc(checkExportDistinct,exports,ambigCheck,subs);
        return;
    } else {
      return;
    }
        
    if (inConflict) {
        ERRMSG(0) "Conflicting exports of entity \"%s\"",
                  textToStr(txt) ETHEN
        ERRTEXT "\n*** Could refer to %s.%s or %s.%s",
  	      textToStr(module(mod1).text),
      	      textToStr(txt),
  	      textToStr(module(mod2).text),
  	      textToStr(txt)
        EEND;
    }
    
    if (ambigCheck && nonNull(clashes)) {
        reportAmbigEntity(module(mod1).text,txt,clashes);
    }
  }
  
  static List local checkExportTycon(exports,mt,viaModExport,spec,tc)
  List  exports;
  Text  mt;
  Bool  viaModExport;
  Cell  spec;
  Tycon tc; {
      checkExportDistinct(exports,!viaModExport,pair(tc,spec));
      if (DOTDOT == spec || SYNONYM == tycon(tc).what) {
  	return addEntity(tc,DOTDOT,exports);
      } else {
  	return addEntity(tc,NIL,exports);
      }
  }
  
  static List local checkExportClass(exports,mt,viaModExport,spec,cl)
  List  exports;
  Text  mt;
  Bool  viaModExport;
  Class cl;
  Cell  spec; {
      checkExportDistinct(exports,!viaModExport,pair(cl,spec));
      if (DOTDOT == spec) {
  	return addEntity(cl,DOTDOT,exports);
      } else {
  	return addEntity(cl,NIL,exports);
      }
  }
  
  static List local checkExportModule(exports,mt,e) 
  List exports;
  Text mt;
  Cell e; {
    /* The name refers to the module alias; get at the modules it refers to */
      Text alias = textOf(snd(e));
      List mods = findQualifiers(alias);
      Module m;
  
      /* Re-exporting a module we didn't import isn't allowed. */
      if (isNull(mods)) {
          ERRMSG(0) "Unknown module \"%s\" exported from module \"%s\"",
  	          textToStr(alias),
  	          textToStr(mt)
  	EEND;
      }
      for (;nonNull(mods);mods=tl(mods)) {
           m = hd(mods);
  	 if (m == currentModule) {
  	     /* Exporting the current module exports all local definitions */
  	     List xs;
  
  	     for(xs=module(m).classes; nonNull(xs); xs=tl(xs)) {
  	       if (cclass(hd(xs)).mod==m) 
  	           exports = checkExportClass(exports,mt,TRUE,DOTDOT,hd(xs));
  	     }
  	     for(xs=module(m).tycons; nonNull(xs); xs=tl(xs)) {
  	       if (tycon(hd(xs)).mod==m) 
  		   exports = checkExportTycon(exports,mt,TRUE,DOTDOT,hd(xs));
  	     }
  	     for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
  	         if (name(hd(xs)).mod==m && 
  		     /* don't add dcons or class members */
  		     (!isCfun(hd(xs)) &&
  		      !isClass(name(hd(xs)).parent))) {
  		     checkExportDistinct(exports,FALSE,hd(xs));
  		     exports = cons(hd(xs),exports);
  		 }
  	     }
  	 } else {
  	     /* Re-exporting a module alias M exports all unqualified
  	      * entities that have been imported into scope by modules
  	      * having that alias _and_ for which the qualified (by
  	      * the _alias_ M) entities are also visible.
  	      */
  	     List xs = module(currentModule).modImports;
  	     List ents = NIL;
  	
  	     for(;nonNull(xs);xs=tl(xs)) {
  	       if (isPair(hd(xs)) && fst(hd(xs)) == m) {
  		   ents = snd(snd(hd(xs)));
  		   break;
  	       }
  	     }
  	     if (isNull(xs)) {
  	         ents = module(m).exports;
  	     }
  	     for(;nonNull(ents);ents=tl(ents)) {
  	       Cell  qid;
  	       Text  txtNm;
  	       Cell ent = NIL;
  	       Name  nm;
  	       Tycon tc;
  	       Class cc;
  	       
  	       /* Build the (alias) qualified entity and test whether it's
  		  in scope -- ugly. */
  	       if (isName(hd(ents))) {
  		   txtNm = name(hd(ents)).text;
  		   qid = mkQId(alias,mkVar(txtNm));
  	       } else if (isTycon(hd(ents))) {
  		   txtNm = tycon(hd(ents)).text;
  		   qid = mkQId(alias,mkCon(txtNm));
  	       } else if (isClass(hd(ents))) {
  		   txtNm = cclass(hd(ents)).text;
  		   qid = mkQId(alias,mkCon(txtNm));
  	       } else if (isQualIdent(hd(ents))) {
  		   txtNm = qtextOf(hd(ents));
  		   qid = mkQId(alias,snd(snd(hd(ents))));
  	       } else {
  		   /* ({tycon|class}, [entity]) */
  		   if (isTycon(fst(hd(ents)))) {
  		       txtNm = tycon(fst(hd(ents))).text;
  		       qid = mkQId(alias,mkCon(txtNm));
  		   } else if (isClass(fst(hd(ents)))) {
  		       txtNm = cclass(fst(hd(ents))).text;
  		       qid = mkQId(alias,mkCon(txtNm));
  		   } else {
  		       internal("checkExportModule");
  		   }
  	       }
  	       /* Decide whether an entity E is to be exported;
  	        * it needs to satisfy the following conditions:
  		*
  		*  - it needs to be visible in unqualified form,
  		*    _unambiguously_.
  		*  - it is also available as A.E (where A is the
  		*    alias used in the module re-exportation element
  		*    in the export list.)
  		*  - the two names refer to the same (declared) name.
  		*/
  	       if ( ( (ent = findName(txtNm))            && 
  		      !isNull((nm = findQualName(qid)))  &&
  		      (nonNull((name(ent).clashes)) ||
  		       name(ent).mod == name(nm).mod))        ||
  		    ( (ent = findTycon(txtNm))           &&
  		      !isNull((tc = findQualTycon(qid))) &&
  		      (nonNull((tycon(ent).clashes)) ||
  		       tycon(ent).mod == tycon(tc).mod))       ||
  		    ( (ent = findClass(txtNm))           && 
  		      !isNull((cc = findQualClass(qid))) &&
  		      (nonNull((cclass(ent).clashes)) ||
  		       cclass(ent).mod == cclass(cc).mod))   ) {
  
  		   checkExportDistinct(exports,FALSE,hd(ents));
  		   exports=cons(hd(ents),exports);
  	       }
  	     }
  	 }
      }
      return exports;
  }
  
  static List local allMethodsOrDCons(imps,nm,mod,wantMethods)
  List   imps;
  Cell   nm;
  Module mod;
  Bool   wantMethods; {
    /* For a non-local tycon / class exported using (..), locate
     * the list of dcons/methods that are in scope.
     *
     * This requires going through all the import lists, locating
     * the tycon/class and take the union of all the dcons/methods
     * found.
     */
    List xs;
    List resList = NIL;
  
    for (xs = imps; nonNull(xs); xs=tl(xs)) {
      if ( isPair(hd(xs)) && isPair(snd(hd(xs))) ) {
        List ns;
        /* Find the entry for 'nm' tycon.. */
        for (ns = snd(snd(hd(xs))); nonNull(ns); ns=tl(ns)) {
  	if ( isPair(hd(ns)) && 
  	     ((!wantMethods         &&
  	       isTycon(fst(hd(ns))) &&
  	       fst(hd(ns)) == nm    &&
  	       tycon(fst(hd(ns))).mod == mod) ||
  	      (wantMethods          &&
  	       isClass(fst(hd(ns))) &&
  	       fst(hd(ns)) == nm    &&
  	       cclass(fst(hd(ns))).mod == mod)) ) {
  	  resList=dupOnto(snd(hd(ns)),resList);
  	  /* Assumption: tycon/class may appear more than
  	     once in an import list; */
  	}
        }
      }
    }
    if (nonNull(resList)) { resList = nubList(resList); }
    return resList;
  }
  
  static List local checkExport(exports,mt,e) /* Process entry in export list */
  List exports;
  Text mt; 
  Cell e; {
      if (isIdent(e)) {
  	Name export;
  	Bool expFound = FALSE;
  
  	if (isQCon(e) && nonNull(export=findQualTycon(e))) {
  	    expFound = TRUE;
  	    exports = checkExportTycon(exports,mt,FALSE,NIL,export);
  	} else if (isQCon(e) && nonNull(export=findQualClass(e))) {
  	    /* opaque class export */
  	    expFound = TRUE;
  	    exports = checkExportClass(exports,mt,FALSE,NIL,export);
  	} else if (nonNull(export=findQualName(e))) {
  	    /* Data constructors cannot appear in export lists,
  	     * so flag an error if they do.
  	     *
  	     * Notice that we have to be a bit careful when testing
  	     * for this, as both data constructors and type synonyms
  	     * have a tycon as parent. (In the case of type synonyms,
  	     * the parent is the type on the RHS.)
  	     *
  	     */
  	  if (  isCfun(export)    &&
  	       !isPreludeScript() && 
  	        currentModule != moduleUserPrelude) {
  	    /* Special case reqd for Prelude(s) to handle (:) */
  		ERRMSG(0) "Illegal export of a lone data constructor \"%s\"",
  		          textToStr(name(export).text)
  	        EEND;
  	  }
  	  expFound = TRUE;
  	  /* Re-use static analysis code to verify that 
  	   * a qualified export isn't ambiguous. Unqualified
  	   * ones are better handled by checkExportDistinct().
  	   */
  	  if (isQualIdent(e)) {
  	    depExpr(1,e);
  	  }
  	  checkExportDistinct(exports,!isQualIdent(e),export);
  	  exports=cons(export,exports);
  	}
  	if (!expFound) {
  	    ERRMSG(0) "Unknown entity \"%s\" exported from module \"%s\"",
  		      identToStr(e),
  		      textToStr(mt)
  	    EEND;
  	}
  	return exports;
      } else if (MODULEENT == fst(e)) {
  	return checkExportModule(exports,mt,e);
      } else {
  	Cell ident = fst(e); /* class name or type name */
  	Cell parts = snd(e); /* members or constructors */
  	Cell nm;
  	if (isQCon(ident) && nonNull(nm=findQualTycon(ident))) {
  	    switch (tycon(nm).what) {
  	    case SYNONYM:
  		if (DOTDOT!=parts) {
  		    ERRMSG(0) "Explicit constructor list given for type synonym \"%s\" in export list of module \"%s\"",
  			      identToStr(ident),
  			      textToStr(mt)
  		    EEND;
  		}
  		exports = addEntity(nm,DOTDOT,exports);
  		return exports;
  	    case RESTRICTSYN:	
  		ERRMSG(0) "Transparent export of restricted type synonym \"%s\" in export list of module \"%s\"",
  			  identToStr(ident),
  			  textToStr(mt)
  		EEND;
  		return exports; /* Not reached */
  	    case NEWTYPE:
  	    case DATATYPE:
  		if (DOTDOT==parts) {
  		    Module thisModule = lastModule();
  		    if ( tycon(nm).mod == thisModule ) {
  		      exports = addEntity(nm,DOTDOT,exports);
  		    } else {
  		      exports = addEntity(nm,
  					  allMethodsOrDCons(module(thisModule).modImports,
  							    nm,
  							    tycon(nm).mod,
  							    FALSE),
  					  exports);
  		    }
  		} else {
  		  List ps = NIL;
  		  ps = checkSubentities(ps,parts,tycon(nm).defn,
  					"constructor of type",
  					tycon(nm).text);
  		  exports = addEntity(nm,ps,exports);
  		}
  		return exports;
  	    default:
  		internal("checkExport1");
  	    }
  	} else if (isQCon(ident) && nonNull(nm=findQualClass(ident))) {
  	    if (DOTDOT == parts) {
  		Module thisModule = lastModule();
  		if ( cclass(nm).mod == thisModule ) {
  		  exports = addEntity(nm,DOTDOT,exports);
  		} else {
  		  exports = addEntity(nm,
  				      allMethodsOrDCons(module(thisModule).modImports,
  							nm,
  							cclass(nm).mod,
  							TRUE),
  				      exports);
  		}
  	    } else {
  	      List ps = NIL;
  	      ps = checkSubentities(ps,parts,cclass(nm).members,
  				    "member of class",cclass(nm).text);
  	      exports=addEntity(nm,ps,exports);
  	    }
  	    return exports;
  	} else {
  	    ERRMSG(0) "Explicit export list given for non-class/datatype \"%s\" in export list of module \"%s\"",
  		      identToStr(ident),
  		      textToStr(mt)
  	    EEND;
  	}
      }
      return exports; /*NOTUSED*/
  }
  
  List checkExports(exports)
  List exports; {
      Module m  = lastModule();
      Text   mt = module(m).text;
      List   es = NIL;             /* [Entity | (Entity,DOTDOT|NIL|[Entity])] */
  
      /* To properly handle methods and field names that are exported 
       * separately from their class/type ('orphans'), we construct the effective
       * export list in two passes. First, we resolve and collect up
       * all the entities, be they orphans or not. Secondly, we fix up
       * this list, attempting to join up the each 'orphan' with its
       * parent, but only if that parent (class/tycon) is also exported.
       * i.e., just exporting a method _does not_ cause its class to
       * implicitly be added to the export list.
       *
       * This only applies to methods and field names; data constructors
       * cannot be exported on their own.
       */
      map1Accum(checkExport,es,mt,exports);
      es = fixupIEList(es);
  
  #if DEBUG_MODULES
      for(xs=es; nonNull(xs); xs=tl(xs)) {
  	Printf(" %s", textToStr(textOfEntity(hd(xs))));
      }
  #endif
      return es;
  }
  
  /* --------------------------------------------------------------------------
   * Browsing module exports
   * ------------------------------------------------------------------------*/
  
  Void browseModule(mod,all)
  Module mod;
  Bool all; {			/* include all names in scope in the module? */
      List exports = resolveImportList(mod, DOTDOT, FALSE);
      Printf("module %s where\n",textToStr(module(mod).text));
      if (all) {
  	List all_names = dupList(module(mod).names);
  	mapProc(browseName,rev(all_names));
      } else {
  	mapProc(browseEntity,exports);
      }
  }
  
  static Void local browseEntity(entity)
  Cell entity; {			 /* Entity | (Entity,[Entity]) */
      if (isName(entity)) {
  	browseName(entity);
      } else {			 /* (Entity,[Entity]) */
  	mapProc(browseName,snd(entity));
      }
  }
  
  static Void local browseName(nm)
  Name nm; {
      /* unwanted artifacts, like lambda lifted values,
         are in the list of names, but have no types */
      if (nonNull(name(nm).type)) {
  	printExp(stdout,nm);
  	Printf(" :: ");
  	printType(stdout,name(nm).type);
  	if (isCfun(nm)) {
  	    Printf("  -- data constructor");
  	} else if (isMfun(nm)) {
  	    Printf("  -- class member");
  	} else if (isSfun(nm)) {
  	    Printf("  -- selector function");
  	}
  	if (name(nm).primDef) {
  	    Printf("  -- primitive");
  	}
  	Printf("\n");
      }
  }
  