+ case GRP_REC:
+ FPrintf ( stderr, " {" );
+ for (v = snd(u); nonNull(v); v=tl(v))
+ FPrintf ( stderr, "%s ", textToStr(textOf(hd(v))) );
+ FPrintf ( stderr, "}\n" );
+ break;
+ default:
+ internal("ppMG");
+ }
+ }
+}
+
+
+static Bool elemMG ( ConId mod )
+{
+ List gs;
+ for (gs = moduleGraph; nonNull(gs); gs=tl(gs))
+ switch (whatIs(hd(gs))) {
+ case GRP_NONREC:
+ if (textOf(mod)==textOf(snd(hd(gs)))) return TRUE;
+ break;
+ case GRP_REC:
+ if (varIsMember(textOf(mod),snd(hd(gs)))) return TRUE;
+ break;
+ default:
+ internal("elemMG");
+ }
+ return FALSE;
+}
+
+
+static ConId selectArbitrarilyFromGroup ( Cell group )
+{
+ switch (whatIs(group)) {
+ case GRP_NONREC: return snd(group);
+ case GRP_REC: return hd(snd(group));
+ default: internal("selectArbitrarilyFromGroup");
+ }
+}
+
+static ConId selectLatestMG ( void )
+{
+ List gs = moduleGraph;
+ if (isNull(gs)) internal("selectLatestMG(1)");
+ while (nonNull(gs) && nonNull(tl(gs))) gs = tl(gs);
+ return selectArbitrarilyFromGroup(hd(gs));
+}
+
+
+static List /* of CONID */ listFromSpecifiedMG ( List mg )
+{
+ List gs;
+ List cs = NIL;
+ for (gs = mg; nonNull(gs); gs=tl(gs)) {
+ switch (whatIs(hd(gs))) {
+ case GRP_REC: cs = appendOnto(cs,snd(hd(gs))); break;
+ case GRP_NONREC: cs = cons(snd(hd(gs)),cs); break;
+ default: internal("listFromSpecifiedMG");
+ }
+ }
+ return cs;
+}
+
+static List /* of CONID */ listFromMG ( void )
+{
+ return listFromSpecifiedMG ( moduleGraph );
+}
+
+
+/* Calculate the strongly connected components of modgList
+ and assign them to moduleGraph. Uses the .uses field of
+ each of the modules to build the graph structure.
+*/
+#define SCC modScc /* make scc algorithm for StgVars */
+#define LOWLINK modLowlink
+#define DEPENDS(t) snd(t)
+#define SETDEPENDS(c,v) snd(c)=v
+#include "scc.c"
+#undef SETDEPENDS
+#undef DEPENDS
+#undef LOWLINK
+#undef SCC
+
+static void mgFromList ( List /* of CONID */ modgList )
+{
+ List t;
+ List u;
+ Text mT;
+ List usesT;
+ List adjList; /* :: [ (Text, [Text]) ] */
+ Module mod;
+ List scc;
+ Bool isRec;
+
+ adjList = NIL;
+ for (t = modgList; nonNull(t); t=tl(t)) {
+ mT = textOf(hd(t));
+ mod = findModule(mT);
+ assert(nonNull(mod));
+ usesT = NIL;
+ for (u = module(mod).uses; nonNull(u); u=tl(u))
+ usesT = cons(textOf(hd(u)),usesT);
+
+ /* artificially give all modules a dependency on Prelude */
+ if (mT != textPrelude && mT != textPrelPrim)
+ usesT = cons(textPrelude,usesT);
+ adjList = cons(pair(mT,usesT),adjList);
+ }
+
+ /* adjList is now [ (module-text, [modules-which-i-import-text]) ].
+ Modify this so that the adjacency list is a list of pointers
+ back to bits of adjList -- that's what modScc needs.
+ */
+ for (t = adjList; nonNull(t); t=tl(t)) {
+ List adj = NIL;
+ /* for each elem of the adjacency list ... */
+ for (u = snd(hd(t)); nonNull(u); u=tl(u)) {
+ List v;
+ Text a = hd(u);
+ /* find the element of adjList whose fst is a */
+ for (v = adjList; nonNull(v); v=tl(v)) {
+ assert(isText(a));
+ assert(isText(fst(hd(v))));
+ if (fst(hd(v))==a) break;
+ }
+ if (isNull(v)) internal("mgFromList");
+ adj = cons(hd(v),adj);
+ }
+ snd(hd(t)) = adj;
+ }
+
+ adjList = modScc ( adjList );
+ /* adjList is now [ [(module-text, aux-info-field)] ] */
+
+ moduleGraph = NIL;
+
+ for (t = adjList; nonNull(t); t=tl(t)) {
+
+ scc = hd(t);
+ /* scc :: [ (module-text, aux-info-field) ] */
+ for (u = scc; nonNull(u); u=tl(u))
+ hd(u) = mkCon(fst(hd(u)));
+
+ /* scc :: [CONID] */
+ if (length(scc) > 1) {
+ isRec = TRUE;
+ } else {
+ /* singleton module in scc; does it import itself? */
+ mod = findModule ( textOf(hd(scc)) );
+ assert(nonNull(mod));
+ isRec = FALSE;
+ for (u = module(mod).uses; nonNull(u); u=tl(u))
+ if (textOf(hd(u))==textOf(hd(scc)))
+ isRec = TRUE;
+ }
+
+ if (isRec)
+ moduleGraph = cons( ap(GRP_REC,scc), moduleGraph ); else
+ moduleGraph = cons( ap(GRP_NONREC,hd(scc)), moduleGraph );
+ }
+ moduleGraph = reverse(moduleGraph);
+}
+
+
+static List /* of CONID */ getModuleImports ( Cell tree )
+{
+ Cell te;
+ List tes;
+ ConId use;
+ List uses = NIL;
+ for (tes = zthd3(unap(M_MODULE,tree)); nonNull(tes); tes=tl(tes)) {
+ te = hd(tes);
+ switch(whatIs(te)) {
+ case M_IMPORT_Q:
+ use = zfst(unap(M_IMPORT_Q,te));
+ assert(isCon(use));
+ if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
+ break;
+ case M_IMPORT_UNQ:
+ use = zfst(unap(M_IMPORT_UNQ,te));
+ assert(isCon(use));
+ if (!varIsMember(textOf(use),uses)) uses = cons ( use, uses );
+ break;
+ default:
+ break;
+ }
+ }
+ return uses;
+}
+
+
+static void processModule ( Module m )
+{
+ Cell tree;
+ ConId modNm;
+ List topEnts;
+ List tes;
+ Cell te;
+ Cell te2;
+
+ tyconDefns = NIL;
+ typeInDefns = NIL;
+ valDefns = NIL;
+ classDefns = NIL;
+ instDefns = NIL;
+ selDefns = NIL;
+ genDefns = NIL;
+ unqualImports = NIL;
+ foreignImports = NIL;
+ foreignExports = NIL;
+ defaultDefns = NIL;
+ defaultLine = 0;
+ inputExpr = NIL;
+
+ setCurrentFile(m);
+ startModule(m);
+ tree = unap(M_MODULE,module(m).tree);
+ modNm = zfst3(tree);
+
+ if (textOf(modNm) != module(m).text) {
+ ERRMSG(0) "Module name \"%s\" does not match file name \"%s%s\"",
+ textToStr(textOf(modNm)),
+ textToStr(module(m).text),
+ textToStr(module(m).srcExt)
+ EEND;
+ }
+
+ setExportList(zsnd3(tree));
+ topEnts = zthd3(tree);
+
+ for (tes = topEnts; nonNull(tes); tes=tl(tes)) {
+ te = hd(tes);
+ assert(isGenPair(te));
+ te2 = snd(te);
+ switch(whatIs(te)) {
+ case M_IMPORT_Q:
+ addQualImport(zfst(te2),zsnd(te2));
+ break;
+ case M_IMPORT_UNQ:
+ addUnqualImport(zfst(te2),zsnd(te2));
+ break;
+ case M_TYCON:
+ tyconDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
+ break;
+ case M_CLASS:
+ classDefn(intOf(zsel14(te2)),zsel24(te2),zsel34(te2),zsel44(te2));
+ break;
+ case M_INST:
+ instDefn(intOf(zfst3(te2)),zsnd3(te2),zthd3(te2));
+ break;
+ case M_DEFAULT:
+ defaultDefn(intOf(zfst(te2)),zsnd(te2));
+ break;
+ case M_FOREIGN_IM:
+ foreignImport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
+ zsel45(te2),zsel55(te2));
+ break;
+ case M_FOREIGN_EX:
+ foreignExport(intOf(zsel15(te2)),zsel25(te2),zsel35(te2),
+ zsel45(te2),zsel55(te2));
+ case M_VALUE:
+ valDefns = cons(te2,valDefns);
+ break;
+ default:
+ internal("processModule");
+ }
+ }
+ checkDefns(m);
+ typeCheckDefns();
+ compileDefns();
+}
+
+
+static Module parseModuleOrInterface ( ConId mc, Cell modeRequest )
+{
+ /* Allocate a module-table entry. */
+ /* Parse the entity and fill in the .tree and .uses entries. */
+ String path;
+ String sExt;
+ Bool sAvail; Time sTime; Long sSize;
+ Bool oiAvail; Time oiTime; Long oSize; Long iSize;
+ Bool ok;
+ Bool useSource;
+ char name[10000];
+
+ Text mt = textOf(mc);
+ Module mod = findModule ( mt );
+
+ /* fprintf ( stderr, "parseModuleOrInterface `%s' == %d\n",
+ textToStr(mt),mod); */
+ if (nonNull(mod) && !module(mod).fake)
+ internal("parseModuleOrInterface");
+ if (nonNull(mod))
+ module(mod).fake = FALSE;
+
+ if (isNull(mod))
+ mod = newModule(mt);
+
+ /* This call malloc-ates path; we should deallocate it. */
+ ok = findFilesForModule (
+ textToStr(module(mod).text),
+ &path,
+ &sExt,
+ &sAvail, &sTime, &sSize,
+ &oiAvail, &oiTime, &oSize, &iSize
+ );
+
+ if (!ok) goto cant_find;
+ if (!sAvail && !oiAvail) goto cant_find;
+
+ /* Find out whether to use source or object. */
+ switch (modeRequest) {
+ case FM_SOURCE:
+ if (!sAvail) goto cant_find;
+ useSource = TRUE;
+ break;
+ case FM_OBJECT:
+ if (!oiAvail) goto cant_find;
+ useSource = FALSE;
+ break;
+ case FM_EITHER:
+ if ( sAvail && !oiAvail) { useSource = TRUE; break; }
+ if (!sAvail && oiAvail) { useSource = FALSE; break; }
+ useSource = firstTimeIsLater ( sTime, oiTime ) ? TRUE : FALSE;
+ break;
+ default:
+ internal("parseModuleOrInterface");
+ }
+
+ /* Actually do the parsing. */
+ if (useSource) {
+ module(mod).srcExt = findText(sExt);
+ setCurrentFile(mod);
+ strcpy(name, path);
+ strcat(name, textToStr(mt));
+ strcat(name, sExt);
+ module(mod).tree = parseModule(name,sSize);
+ module(mod).uses = getModuleImports(module(mod).tree);
+ module(mod).mode = FM_SOURCE;
+ module(mod).lastStamp = sTime;
+ } else {
+ module(mod).srcExt = findText(HI_ENDING);
+ setCurrentFile(mod);
+ strcpy(name, path);
+ strcat(name, textToStr(mt));
+ strcat(name, DLL_ENDING);
+ module(mod).objName = findText(name);
+ module(mod).objSize = oSize;
+ strcpy(name, path);
+ strcat(name, textToStr(mt));
+ strcat(name, ".u_hi");
+ module(mod).tree = parseInterface(name,iSize);
+ module(mod).uses = getInterfaceImports(module(mod).tree);
+ module(mod).mode = FM_OBJECT;
+ module(mod).lastStamp = oiTime;
+ }
+
+ if (path) free(path);
+ return mod;
+
+ cant_find:
+ if (path) free(path);
+ clearCurrentFile();
+ ERRMSG(0)
+ "Can't find %s for module \"%s\"",
+ modeToString(modeRequest), textToStr(mt)
+ EEND;
+}
+
+
+static void tryLoadGroup ( Cell grp )
+{
+ Module m;
+ List t;
+ switch (whatIs(grp)) {
+ case GRP_NONREC:
+ m = findModule(textOf(snd(grp)));
+ assert(nonNull(m));
+ if (module(m).mode == FM_SOURCE) {
+ processModule ( m );
+ module(m).tree = NIL;
+ } else {
+ processInterfaces ( singleton(snd(grp)) );
+ m = findModule(textOf(snd(grp)));
+ assert(nonNull(m));
+ module(m).tree = NIL;
+ }
+ break;
+ case GRP_REC:
+ for (t = snd(grp); nonNull(t); t=tl(t)) {
+ m = findModule(textOf(hd(t)));
+ assert(nonNull(m));
+ if (module(m).mode == FM_SOURCE) {
+ ERRMSG(0) "Source module \"%s\" imports itself recursively",
+ textToStr(textOf(hd(t)))
+ EEND;
+ }
+ }
+ processInterfaces ( snd(grp) );
+ for (t = snd(grp); nonNull(t); t=tl(t)) {
+ m = findModule(textOf(hd(t)));
+ assert(nonNull(m));
+ module(m).tree = NIL;
+ }
+ break;
+ default:
+ internal("tryLoadGroup");
+ }
+}
+
+
+static void fallBackToPrelModules ( void )
+{
+ Module m;
+ for (m = MODULE_BASE_ADDR;
+ m < MODULE_BASE_ADDR+tabModuleSz; m++)
+ if (module(m).inUse
+ && !varIsMember(module(m).text, prelModules))
+ nukeModule(m);
+}
+
+
+/* This function catches exceptions in most of the system.
+ So it's only ok for procedures called from this one
+ to do EENDs (ie, write error messages). Others should use
+ EEND_NO_LONGJMP.
+*/
+static void achieveTargetModules ( Bool loadingThePrelude )
+{
+ volatile List ood;
+ volatile List modgList;
+ volatile List t;
+ volatile Module mod;
+ volatile Bool ok;
+
+ String path = NULL;
+ String sExt = NULL;
+ Bool sAvail; Time sTime; Long sSize;
+ Bool oiAvail; Time oiTime; Long oSize; Long iSize;
+
+ volatile Time oisTime;
+ volatile Bool out_of_date;
+ volatile List ood_new;
+ volatile List us;
+ volatile List modgList_new;
+ volatile List parsedButNotLoaded;
+ volatile List toChase;
+ volatile List trans_cl;
+ volatile List trans_cl_new;
+ volatile List u;
+ volatile List mg;
+ volatile List mg2;
+ volatile Cell grp;
+ volatile List badMods;
+
+ setBreakAction ( HugsIgnoreBreak );
+
+ /* First, examine timestamps to find out which modules are
+ out of date with respect to the source/interface/object files.
+ */
+ ood = NIL;
+ modgList = listFromMG();
+
+ for (t = modgList; nonNull(t); t=tl(t)) {
+
+ if (varIsMember(textOf(hd(t)),prelModules))
+ continue;
+
+ mod = findModule(textOf(hd(t)));
+ if (isNull(mod)) internal("achieveTargetSet(1)");
+
+ /* In standalone mode, only succeeds for source modules. */
+ ok = findFilesForModule (
+ textToStr(module(mod).text),
+ &path,
+ &sExt,
+ &sAvail, &sTime, &sSize,
+ &oiAvail, &oiTime, &oSize, &iSize
+ );
+
+ if (!combined && !sAvail) ok = FALSE;
+ if (!ok) {
+ fallBackToPrelModules();
+ ERRMSG(0)
+ "Can't find source or object+interface for module \"%s\"",
+ textToStr(module(mod).text)
+ EEND_NO_LONGJMP;
+ if (path) free(path);
+ return;
+ }
+
+ if (sAvail && oiAvail) {
+ oisTime = whicheverIsLater(sTime,oiTime);
+ }
+ else if (sAvail && !oiAvail) {
+ oisTime = sTime;
+ }
+ else if (!sAvail && oiAvail) {
+ oisTime = oiTime;
+ }
+ else {
+ internal("achieveTargetSet(2)");
+ }
+
+ out_of_date = firstTimeIsLater(oisTime,module(mod).lastStamp);
+ if (out_of_date) {
+ assert(!varIsMember(textOf(hd(t)),ood));
+ ood = cons(hd(t),ood);
+ }
+
+ if (path) { free(path); path = NULL; };
+ }
+
+ /* Second, form a simplistic transitive closure of the out-of-date
+ modules: a module is out of date if it imports an out-of-date
+ module.
+ */
+ while (1) {
+ ood_new = NIL;
+ for (t = modgList; nonNull(t); t=tl(t)) {
+ mod = findModule(textOf(hd(t)));
+ assert(nonNull(mod));
+ for (us = module(mod).uses; nonNull(us); us=tl(us))
+ if (varIsMember(textOf(hd(us)),ood))
+ break;
+ if (nonNull(us)) {
+ if (varIsMember(textOf(hd(t)),prelModules))
+ Printf ( "warning: prelude module \"%s\" is out-of-date\n",
+ textToStr(textOf(hd(t))) );
+ else
+ if (!varIsMember(textOf(hd(t)),ood_new) &&
+ !varIsMember(textOf(hd(t)),ood))
+ ood_new = cons(hd(t),ood_new);
+ }
+ }
+ if (isNull(ood_new)) break;
+ ood = appendOnto(ood_new,ood);
+ }
+
+ /* Now ood holds the entire set of modules which are out-of-date.
+ Throw them out of the system, yielding a "reduced system",
+ in which the remaining modules are in-date.
+ */
+ for (t = ood; nonNull(t); t=tl(t)) {
+ mod = findModule(textOf(hd(t)));
+ assert(nonNull(mod));
+ nukeModule(mod);
+ }
+ modgList_new = NIL;
+ for (t = modgList; nonNull(t); t=tl(t))
+ if (!varIsMember(textOf(hd(t)),ood))
+ modgList_new = cons(hd(t),modgList_new);
+ modgList = modgList_new;
+
+ /* Update the module group list to reflect the reduced system.
+ We do this so that if the following parsing phases fail, we can
+ safely fall back to the reduced system.
+ */
+ mgFromList ( modgList );
+
+ /* Parse modules/interfaces, collecting parse trees and chasing
+ imports, starting from the target set.
+ */
+ toChase = dupList(targetModules);
+ for (t = toChase; nonNull(t); t=tl(t)) {
+ Cell mode = (!combined)
+ ? FM_SOURCE
+ : ( (loadingThePrelude && combined)
+ ? FM_OBJECT
+ : FM_EITHER );
+ hd(t) = zpair(hd(t), mode);
+ }
+
+ /* toChase :: [ ((ConId, {FM_SOURCE|FM_OBJECT|FM_EITHER} )) ] */
+
+ parsedButNotLoaded = NIL;
+
+
+ while (nonNull(toChase)) {
+ ConId mc = zfst(hd(toChase));
+ Cell mode = zsnd(hd(toChase));
+ toChase = tl(toChase);
+ if (varIsMember(textOf(mc),modgList)
+ || varIsMember(textOf(mc),parsedButNotLoaded)) {
+ /* either exists fully, or is at least parsed */
+ mod = findModule(textOf(mc));
+ assert(nonNull(mod));
+ if (!compatibleNewMode(mode,module(mod).mode)) {
+ clearCurrentFile();
+ ERRMSG(0)
+ "module %s: %s required, but %s is more recent",
+ textToStr(textOf(mc)), modeToString(mode),
+ modeToString(module(mod).mode)
+ EEND_NO_LONGJMP;
+ goto parseException;
+ }
+ } else {
+
+ setBreakAction ( HugsLongjmpOnBreak );
+ if (setjmp(catch_error)==0) {
+ /* try this; it may throw an exception */
+ mod = parseModuleOrInterface ( mc, mode );
+ } else {
+ /* here's the exception handler, if parsing fails */
+ /* A parse error (or similar). Clean up and abort. */
+ parseException:
+ setBreakAction ( HugsIgnoreBreak );
+ mod = findModule(textOf(mc));
+ if (nonNull(mod)) nukeModule(mod);
+ for (t = parsedButNotLoaded; nonNull(t); t=tl(t)) {
+ mod = findModule(textOf(hd(t)));
+ assert(nonNull(mod));
+ if (nonNull(mod)) nukeModule(mod);
+ }
+ return;
+ /* end of the exception handler */
+ }
+ setBreakAction ( HugsIgnoreBreak );
+
+ parsedButNotLoaded = cons(mc, parsedButNotLoaded);
+ for (t = module(mod).uses; nonNull(t); t=tl(t))
+ toChase = cons(
+ zpair( hd(t), childMode(mode,module(mod).mode) ),
+ toChase);
+ }
+ }
+
+ modgList = dupOnto(parsedButNotLoaded, modgList);
+
+ /* We successfully parsed all modules reachable from the target
+ set which were not part of the reduced system. However, there
+ may be modules in the reduced system which are not reachable from
+ the target set. We detect these now by building the transitive
+ closure of the target set, and nuking modules in the reduced
+ system which are not part of that closure.
+ */
+ trans_cl = dupList(targetModules);
+ while (1) {
+ trans_cl_new = NIL;
+ for (t = trans_cl; nonNull(t); t=tl(t)) {
+ mod = findModule(textOf(hd(t)));
+ assert(nonNull(mod));
+ for (u = module(mod).uses; nonNull(u); u=tl(u))
+ if (!varIsMember(textOf(hd(u)),trans_cl)
+ && !varIsMember(textOf(hd(u)),trans_cl_new)
+ && !varIsMember(textOf(hd(u)),prelModules))
+ trans_cl_new = cons(hd(u),trans_cl_new);
+ }
+ if (isNull(trans_cl_new)) break;
+ trans_cl = appendOnto(trans_cl_new,trans_cl);
+ }
+ modgList_new = NIL;
+ for (t = modgList; nonNull(t); t=tl(t)) {
+ if (varIsMember(textOf(hd(t)),trans_cl)) {
+ modgList_new = cons(hd(t),modgList_new);
+ } else {
+ mod = findModule(textOf(hd(t)));
+ assert(nonNull(mod));
+ nukeModule(mod);
+ }
+ }
+ modgList = modgList_new;
+
+ /* Now, the module symbol tables hold exactly the set of
+ modules reachable from the target set, and modgList holds
+ their names. Calculate the scc-ified module graph,
+ since we need that to guide the next stage, that of
+ Actually Loading the modules.
+
+ If no errors occur, moduleGraph will reflect the final graph
+ loaded. If an error occurs loading a group, we nuke
+ that group, truncate the moduleGraph just prior to that
+ group, and exit. That leaves the system having successfully
+ loaded all groups prior to the one which failed.
+ */
+ mgFromList ( modgList );
+
+ for (mg = moduleGraph; nonNull(mg); mg=tl(mg)) {
+ grp = hd(mg);
+
+ if (!varIsMember(textOf(selectArbitrarilyFromGroup(grp)),
+ parsedButNotLoaded)) continue;
+
+ setBreakAction ( HugsLongjmpOnBreak );
+ if (setjmp(catch_error)==0) {
+ /* try this; it may throw an exception */
+ tryLoadGroup(grp);
+ } else {
+ /* here's the exception handler, if static/typecheck etc fails */
+ /* nuke the entire rest (ie, the unloaded part)
+ of the module graph */
+ setBreakAction ( HugsIgnoreBreak );
+ badMods = listFromSpecifiedMG ( mg );
+ for (t = badMods; nonNull(t); t=tl(t)) {
+ mod = findModule(textOf(hd(t)));
+ if (nonNull(mod)) nukeModule(mod);
+ }
+ /* truncate the module graph just prior to this group. */
+ mg2 = NIL;
+ mg = moduleGraph;
+ while (TRUE) {
+ if (isNull(mg)) break;
+ if (hd(mg) == grp) break;
+ mg2 = cons ( hd(mg), mg2 );
+ mg = tl(mg);
+ }
+ moduleGraph = reverse(mg2);
+ return;
+ /* end of the exception handler */
+ }
+ setBreakAction ( HugsIgnoreBreak );
+ }
+
+ /* Err .. I think that's it. If we get here, we've successfully
+ achieved the target set. Phew!
+ */
+ setBreakAction ( HugsIgnoreBreak );
+}
+
+
+static Bool loadThePrelude ( void )
+{
+ Bool ok;
+ ConId conPrelude;
+ ConId conPrelHugs;
+ moduleGraph = prelModules = NIL;
+
+ if (combined) {
+ conPrelude = mkCon(findText("Prelude"));
+ conPrelHugs = mkCon(findText("PrelHugs"));
+ targetModules = doubleton(conPrelude,conPrelHugs);
+ achieveTargetModules(TRUE);
+ ok = elemMG(conPrelude) && elemMG(conPrelHugs);
+ } else {
+ conPrelude = mkCon(findText("Prelude"));
+ targetModules = singleton(conPrelude);
+ achieveTargetModules(TRUE);
+ ok = elemMG(conPrelude);
+ }
+
+ if (ok) prelModules = listFromMG();
+ return ok;
+}
+
+
+/* Refresh the current target modules, and attempt to set the
+ current module to what it was before (ie currentModule):
+ if currentModule_failed is different from currentModule,
+ use that instead
+ if nextCurrMod is non null, try to set it to that instead
+ if the one we're after insn't available, select a target
+ from the end of the module group list.
+*/
+static void refreshActions ( ConId nextCurrMod, Bool cleanAfter )
+{
+ List t;
+ ConId tryFor;
+
+ /* Remember what the old current module was. */
+ tryFor = mkCon(module(currentModule).text);
+
+ /* Do the Real Work. */
+ achieveTargetModules(FALSE);
+
+ /* Remember if the current module was invalidated by this
+ refresh, so later refreshes can attempt to reload it. */
+ if (!elemMG(tryFor))
+ currentModule_failed = tryFor;
+
+ /* If a previous refresh failed to get an old current module,
+ try for that instead. */
+ if (nonNull(currentModule_failed)
+ && textOf(currentModule_failed) != textOf(tryFor)
+ && elemMG(currentModule_failed))
+ tryFor = currentModule_failed;
+ /* If our caller specified a new current module, that overrides
+ all historical settings. */
+ if (nonNull(nextCurrMod))
+ tryFor = nextCurrMod;
+ /* Finally, if we can't actually get hold of whatever it was we
+ were after, select something which is possible. */
+ if (!elemMG(tryFor))
+ tryFor = selectLatestMG();
+
+ /* combined mode kludge, to get Prelude rather than PrelHugs */
+ if (combined && textOf(tryFor)==findText("PrelHugs"))
+ tryFor = mkCon(findText("Prelude"));
+
+ if (cleanAfter) {
+ /* delete any targetModules which didn't actually get loaded */
+ t = targetModules;
+ targetModules = NIL;
+ for (; nonNull(t); t=tl(t))
+ if (elemMG(hd(t)))
+ targetModules = cons(hd(t),targetModules);
+ }
+
+ setCurrModule ( findModule(textOf(tryFor)) );
+ Printf("Hugs session for:\n");
+ ppMG();
+}
+
+
+static void addActions ( List extraModules /* :: [CONID] */ )
+{
+ List t;
+ for (t = extraModules; nonNull(t); t=tl(t)) {
+ ConId extra = hd(t);
+ if (!varIsMember(textOf(extra),targetModules))
+ targetModules = cons(extra,targetModules);
+ }
+ refreshActions ( isNull(extraModules)
+ ? NIL
+ : hd(reverse(extraModules)),
+ TRUE
+ );
+}
+
+
+static void loadActions ( List loadModules /* :: [CONID] */ )
+{
+ List t;
+ targetModules = dupList ( prelModules );
+
+ for (t = loadModules; nonNull(t); t=tl(t)) {
+ ConId load = hd(t);
+ if (!varIsMember(textOf(load),targetModules))
+ targetModules = cons(load,targetModules);
+ }
+ refreshActions ( isNull(loadModules)
+ ? NIL
+ : hd(reverse(loadModules)),
+ TRUE
+ );