[project @ 2000-04-27 16:35:29 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / hugs.c
index c1120b1..2cef783 100644 (file)
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.65 $
- * $Date: 2000/04/10 14:28:14 $
+ * $Revision: 1.69 $
+ * $Date: 2000/04/27 16:35:29 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -80,6 +80,8 @@ static Void   local failed            ( Void );
 static String local strCopy           ( String );
 static Void   local browseit         ( Module,String,Bool );
 static Void   local browse           ( Void );
+static void   local clearCurrentFile  ( void );
+
 
 /* --------------------------------------------------------------------------
  * Machine dependent code for Hugs interpreter:
@@ -120,6 +122,9 @@ static Bool   disableOutput = FALSE;    /* TRUE => quiet                   */
 
        List  ifaces_outstanding = NIL;
 
+static ConId currentModule_failed = NIL; /* Remember failed module from :r */
+
+
 
 /* --------------------------------------------------------------------------
  * Hugs entry point:
@@ -168,7 +173,7 @@ char *argv[]; {
 
     Printf("__   __ __  __  ____   ___      _________________________________________\n");
     Printf("||   || ||  || ||  || ||__      STGHugs: Based on the Haskell 98 standard\n");
-    Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-1999\n");
+    Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-2000\n");
     Printf("||---||         ___||           World Wide Web: http://haskell.org/hugs\n");
     Printf("||   ||                         Report bugs to: hugs-bugs@haskell.org\n");
     Printf("||   || Version: %s _________________________________________\n\n",HUGS_VERSION);
@@ -312,8 +317,9 @@ Bool state; {
             *toggle[i].flag = state;
             return;
         }
+    clearCurrentFile();
     ERRMSG(0) "Unknown toggle `%c'", c
-    EEND;
+    EEND_NO_LONGJMP;
 }
 
 static Void local togglesIn(state)      /* Print current list of toggles in*/
@@ -666,7 +672,7 @@ static Void local changeDir() {         /* change directory                */
     String s = readFilename();
     if (s && chdir(s)) {
         ERRMSG(0) "Unable to change to directory \"%s\"", s
-        EEND;
+        EEND_NO_LONGJMP;
     }
 }
 
@@ -1525,26 +1531,56 @@ static Bool loadThePrelude ( void )
 }
 
 
+/* 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 = mkCon(module(currentModule).text);
+   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);
+      /* 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)) );
@@ -1727,6 +1763,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
         bd = type;
 
     if (whatIs(bd)==QUAL) {
+       printing = FALSE;
+       clearCurrentFile();
        ERRMSG(0) "Unresolved overloading" ETHEN
        ERRTEXT   "\n*** Type       : "    ETHEN ERRTYPE(type);
        ERRTEXT   "\n*** Expression : "    ETHEN ERREXPR(inputExpr);
@@ -1736,6 +1774,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
     }
   
 #if 1
+    printing      = TRUE;
+    numEnters     = 0;
     if (isProgType(ks,bd)) {
         inputExpr = ap(nameRunIO_toplevel,inputExpr);
         evalExp();
@@ -1743,6 +1783,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
     } else {
         Cell d = provePred(ks,NIL,ap(classShow,bd));
         if (isNull(d)) {
+           clearCurrentFile();
+           printing = FALSE;
            ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
            ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
            ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
@@ -1777,6 +1819,7 @@ static Void local evaluator() {        /* evaluate expr and print value    */
    nukeModule(evalMod);
    setCurrModule(currMod);
    setCurrentFile(currMod);
+   stopAnyPrinting();
 }
 
 
@@ -2266,6 +2309,7 @@ static Void local listNames() {         /* list names matching optional pat*/
         names = addNamesMatching((String)0,names);
     }
     if (isNull(names)) {                /* Then print them out             */
+        clearCurrentFile();
         ERRMSG(0) "No names selected"
         EEND_NO_LONGJMP;
         return;
@@ -2329,7 +2373,6 @@ String argv[]; {
     modConIds = initialize(argc,argv);  /* the initial modules to load     */
     setBreakAction ( HugsIgnoreBreak );
     prelOK    = loadThePrelude();
-    if (combined) everybody(POSTPREL);
 
     if (!prelOK) {
        if (autoMain)
@@ -2339,6 +2382,7 @@ String argv[]; {
        exit(1);
     }    
 
+    if (combined) everybody(POSTPREL);
     loadActions(modConIds);
 
     if (autoMain) {
@@ -2369,8 +2413,10 @@ String argv[]; {
             case FIND   : find();
                           break;
             case LOAD   : modConIds = NIL;
-                          while ((s=readFilename())!=0)
-                             modConIds = cons(mkCon(findText(s)),modConIds);
+               while ((s=readFilename())!=0) {
+                          modConIds = cons(mkCon(findText(s)),modConIds);
+
+               }
                           loadActions(modConIds);
                           modConIds = NIL;
                           break;
@@ -2530,10 +2576,7 @@ static Void local stopAnyPrinting() {  /* terminate printing of expression,*/
         Putchar('\n');
         if (showStats) {
 #define plural(v)   v, (v==1?"":"s")
-            Printf("%lu cell%s",plural(numCells));
-            if (numGcs>0)
-                Printf(", %u garbage collection%s",plural(numGcs));
-            Printf(")\n");
+           Printf("(%lu enter%s)\n",plural(numEnters));
 #undef plural
         }
         FlushStdout();
@@ -2752,10 +2795,13 @@ Int what; {                     /* system to respond as appropriate ...    */
     compiler(what);   
     codegen(what);
 
-    mark(moduleGraph);
-    mark(prelModules);
-    mark(targetModules);
-    mark(daSccs);
+    if (what == MARK) {
+       mark(moduleGraph);
+       mark(prelModules);
+       mark(targetModules);
+       mark(daSccs);
+       mark(currentModule_failed);
+    }
 }
 
 /*-------------------------------------------------------------------------*/