[project @ 1999-11-25 10:19:15 by sewardj]
[ghc-hetmet.git] / ghc / interpreter / hugs.c
index bb8fa93..f1272c6 100644 (file)
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.19 $
- * $Date: 1999/11/12 17:32:39 $
+ * $Revision: 1.24 $
+ * $Date: 1999/11/25 10:19:16 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -90,7 +90,7 @@ static Void   local forgetScriptsFrom Args((Script));
 static Void   local setLastEdit       Args((String,Int));
 static Void   local failed            Args((Void));
 static String local strCopy           Args((String));
-static Void   local browseit         Args((Module,String));
+static Void   local browseit         Args((Module,String,Bool));
 static Void   local browse           Args((Void));
 
 /* --------------------------------------------------------------------------
@@ -224,26 +224,29 @@ char *argv[]; {
 
     CStackBase = &argc;                 /* Save stack base for use in gc   */
 
-    /* Try and figure out an absolute path to the executable, so
-       we can make a reasonable guess about where the default
-       libraries (Prelude etc) are.
-    */
-    setDefaultLibDir ( argv[0] );
-
     /* If first arg is +Q or -Q, be entirely silent, and automatically run
        main after loading scripts.  Useful for running the nofib suite.    */
     if (argc > 1 && (strcmp(argv[1],"+Q") == 0 || strcmp(argv[1],"-Q")==0)) {
        autoMain = TRUE;
-       hugsEnableOutput(0);
+       if (strcmp(argv[1],"-Q") == 0) {
+        hugsEnableOutput(0);
+       }
     }
 
     Printf("__   __ __  __  ____   ___      _________________________________________\n");
-    Printf("||   || ||  || ||  || ||__      Hugs 98: Based on the Haskell 98 standard\n");
+    Printf("||   || ||  || ||  || ||__      STGHugs: Based on the Haskell 98 standard\n");
     Printf("||___|| ||__|| ||__||  __||     Copyright (c) 1994-1999\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);
 
+    /* Get the absolute path to the directory containing the hugs 
+       executable, so that we know where the Prelude and nHandle.so/.dll are.
+       We do this by reading env var STGHUGSDIR.  This needs to succeed, so
+       setInstallDir won't return unless it succeeds.
+    */
+    setInstallDir ( argv[0] );
+
 #if SYMANTEC_C
     Printf("   Ported to Macintosh by Hans Aberg, compiled " __DATE__ ".\n\n");
 #endif
@@ -316,8 +319,13 @@ String argv[]; {
         }
     }
 
-#ifdef DEBUG
-    DEBUG_LoadSymbols(argv_0_orig);
+#if DEBUG
+    { 
+       char exe_name[N_INSTALLDIR + 6];
+       strcpy(exe_name, installDir);
+       strcat(exe_name, "hugs");
+       DEBUG_LoadSymbols(exe_name);
+    }
 #endif
 
 
@@ -1342,7 +1350,7 @@ static Void local evaluator() {        /* evaluate expr and print value    */
 #endif
 
 #if 1
-    if (typeMatches(type,ap(typeIO,typeUnit))) {
+    if (isProgType(ks,bd)) {
         inputExpr = ap(nameRunIO,inputExpr);
         evalExp();
         Putchar('\n');
@@ -1417,16 +1425,19 @@ static Void local showtype() {         /* print type of expression (if any)*/
 }
 
 
-static Void local browseit(mod,t)
+static Void local browseit(mod,t,all)
 Module mod; 
-String t; {
+String t;
+Bool all; {
     if (nonNull(mod)) {
        Cell cs;
-       Printf("module %s where\n",textToStr(module(mod).text));
+       if (nonNull(t))
+           Printf("module %s where\n",textToStr(module(mod).text));
        for (cs = module(mod).names; nonNull(cs); cs=tl(cs)) {
            Name nm = hd(cs);
-           /* only look at things defined in this module */
-           if (name(nm).mod == mod) {
+           /* only look at things defined in this module,
+              unless `all' flag is set */
+           if (all || name(nm).mod == mod) {
                /* unwanted artifacts, like lambda lifted values,
                   are in the list of names, but have no types */
                if (nonNull(name(nm).type)) {
@@ -1454,20 +1465,23 @@ String t; {
 static Void local browse() {            /* browse modules                  */
     Int    count = 0;                   /* or give menu of commands        */
     String s;
+    Bool all = FALSE;
 
     setCurrModule(findEvalModule());
     startNewScript(0);                  /* for recovery of storage         */
-    for (; (s=readFilename())!=0; count++) {
-       browseit(findModule(findText(s)),s);
-    }
+    for (; (s=readFilename())!=0; count++)
+       if (strcmp(s,"all") == 0) {
+           all = TRUE;
+           --count;
+       } else
+           browseit(findModule(findText(s)),s,all);
     if (count == 0) {
-       whatScripts();
+       browseit(findEvalModule(),NULL,all);
     }
 }
 
 #if EXPLAIN_INSTANCE_RESOLUTION
 static Void local xplain() {         /* print type of expression (if any)*/
-    Cell type;
     Cell d;
     Bool sir = showInstRes;
 
@@ -1997,7 +2011,12 @@ static Int    charCount;
 Void setGoal(what, t)                  /* Set goal for what to be t        */
 String what;
 Target t; {
-    if (quiet) return;
+    if (quiet)
+      return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+    if (showInstRes)
+      return;
+#endif
     currTarget = (t?t:1);
     aiming     = TRUE;
     if (useDots) {
@@ -2013,7 +2032,12 @@ Target t; {
 
 Void soFar(t)                          /* Indicate progress towards goal   */
 Target t; {                            /* has now reached t                */
-    if (quiet) return;
+    if (quiet)
+      return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+    if (showInstRes)
+      return;
+#endif
     if (useDots) {
         Int newPos = (Int)((maxPos * ((long)t))/currTarget);
 
@@ -2031,7 +2055,12 @@ Target t; {                            /* has now reached t                */
 }
 
 Void done() {                          /* Goal has now been achieved       */
-    if (quiet) return;
+    if (quiet)
+      return;
+#if EXPLAIN_INSTANCE_RESOLUTION
+    if (showInstRes)
+      return;
+#endif
     if (useDots) {
         while (maxPos>currPos++)
             Putchar('.');