/* --------------------------------------------------------------------------
 * 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");
    }
}