[project @ 2000-04-25 17:43:49 by andy]

o Adding simple counter for number of enters
o Inc version number
o Adding the start of support for mdo
o Wibble

diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h
index 60f453c..3fe4658 100644 (file)
--- a/ghc/interpreter/connect.h
+++ b/ghc/interpreter/connect.h
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: connect.h,v $
- * $Revision: 1.38 $
- * $Date: 2000/04/10 09:40:03 $
+ * $Revision: 1.39 $
+ * $Date: 2000/04/25 17:43:49 $
  * ------------------------------------------------------------------------*/
 
 /* --------------------------------------------------------------------------
@@ -312,6 +312,7 @@ extern Int    whnfInt;                  /* integer value of term in whnf   */
 extern Float  whnfFloat;                /* float value of term in whnf     */
 extern Long   numCells;                 /* number of cells allocated       */
 extern Int    numGcs;                   /* number of garbage collections   */
+extern int    numEnters;               /* number of enters                */
 extern Bool   preludeLoaded;            /* TRUE => prelude has been loaded */
 extern Bool   flagAssert;               /* TRUE => assert False <e> causes
                                                    an assertion failure    */

diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c
index e2507bc..13776b5 100644 (file)
--- a/ghc/interpreter/hugs.c
+++ b/ghc/interpreter/hugs.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.67 $
- * $Date: 2000/04/17 11:39:23 $
+ * $Revision: 1.68 $
+ * $Date: 2000/04/25 17:43:49 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -173,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);
@@ -1763,6 +1763,7 @@ 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);
@@ -1773,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();
@@ -1780,7 +1783,8 @@ static Void local evaluator() {        /* evaluate expr and print value    */
     } else {
         Cell d = provePred(ks,NIL,ap(classShow,bd));
         if (isNull(d)) {
-       clearCurrentFile();
+           clearCurrentFile();
+           printing = FALSE;
            ERRMSG(0) "Cannot find \"show\" function for:" ETHEN
            ERRTEXT   "\n*** expression : "   ETHEN ERREXPR(inputExpr);
            ERRTEXT   "\n*** of type    : "   ETHEN ERRTYPE(type);
@@ -1815,6 +1819,7 @@ static Void local evaluator() {        /* evaluate expr and print value    */
    nukeModule(evalMod);
    setCurrModule(currMod);
    setCurrentFile(currMod);
+   stopAnyPrinting();
 }
 
 
@@ -2408,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;
@@ -2569,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();

diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c
index 0b5a521..63ebe07 100644 (file)
--- a/ghc/interpreter/input.c
+++ b/ghc/interpreter/input.c
@@ -1,4 +1,3 @@
-
 /* --------------------------------------------------------------------------
  * Input functions, lexical analysis parsing etc...
  *
@@ -9,8 +8,8 @@
  * included in the distribution.
  *
  * $RCSfile: input.c,v $
- * $Revision: 1.29 $
- * $Date: 2000/04/21 18:07:47 $
+ * $Revision: 1.30 $
+ * $Date: 2000/04/25 17:43:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -133,6 +132,7 @@ static Text textCase,    textOfK,      textData,   textType,   textIf;
 static Text textThen,    textElse,     textWhere,  textLet,    textIn;
 static Text textInfix,   textInfixl,   textInfixr, textForeign, textNewtype;
 static Text textDefault, textDeriving, textDo,     textClass,  textInstance;
+static Text textMdo;
 #if IPARAM
 static Text textWith,  textDlet;
 #endif
@@ -1216,7 +1216,7 @@ String readFilename() {                /* Read filename from input (if any)*/
 
     startToken();
     while (c0!=EOF && !isIn(c0,ZPACE)) {
-        if (c0=='"') {
+       if (c0=='"') {
             skip();
             while (c0!=EOF && c0!='\"') {
                 Cell c = readAChar(TRUE);
@@ -1524,6 +1524,7 @@ static Int local yylex() {             /* Read next input token ...        */
 #if IPARAM
        if (it==textWith && !haskell98) lookAhead(WITH);
        if (it==textDlet && !haskell98) lookAhead(DLET);
+        if (it==textMdo && !haskell98)  lookAhead(MDO);
 #endif
         if (it==textUUAll)             return ALL;
         if (it==textUUUsage)           return UUUSAGE;
@@ -1678,6 +1679,7 @@ Int what; {
                        textDefault    = findText("default");
                        textDeriving   = findText("deriving");
                        textDo         = findText("do");
+                       textMdo        = findText("mdo");
                        textClass      = findText("class");
 #if IPARAM
                       textWith       = findText("with");

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index 1458074..31d8d37 100644 (file)
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: interface.c,v $
- * $Revision: 1.55 $
- * $Date: 2000/04/17 13:28:17 $
+ * $Revision: 1.56 $
+ * $Date: 2000/04/25 17:43:49 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -2703,7 +2703,6 @@ Type type; {
 
 
 
-
 /* entirely bogus claims about types of these symbols */
 #define Sym(vvv)  extern void (vvv);
 #define SymX(vvv) /**/

diff --git a/ghc/interpreter/output.c b/ghc/interpreter/output.c
index ad8b0ff..c4ed363 100644 (file)
--- a/ghc/interpreter/output.c
+++ b/ghc/interpreter/output.c
@@ -10,8 +10,8 @@
  * included in the distribution.
  *
  * $RCSfile: output.c,v $
- * $Revision: 1.17 $
- * $Date: 2000/03/23 14:54:21 $
+ * $Revision: 1.18 $
+ * $Date: 2000/04/25 17:43:50 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -188,6 +188,9 @@ Cell e; {
         case DOCOMP     : putStr("do {...}");
                           break;
 
+        case MDOCOMP    : putStr("do {...}");
+                          break;
+
         case COMP       : putComp(fst(snd(e)),snd(snd(e)));
                           break;
 

diff --git a/ghc/interpreter/parser.y b/ghc/interpreter/parser.y
index 3c999cf..13b3b0a 100644 (file)
--- a/ghc/interpreter/parser.y
+++ b/ghc/interpreter/parser.y
@@ -12,8 +12,8 @@
  * included in the distribution.
  *
  * $RCSfile: parser.y,v $
- * $Revision: 1.29 $
- * $Date: 2000/04/17 13:28:17 $
+ * $Revision: 1.30 $
+ * $Date: 2000/04/25 17:43:50 $
  * ------------------------------------------------------------------------*/
 
 %{
@@ -80,6 +80,7 @@ static Void   local noIP       ( String );
 %token THEN       ELSE       WHERE      LET        IN
 %token INFIXN     INFIXL     INFIXR     FOREIGN    TNEWTYPE
 %token DEFAULT    DERIVING   DO         TCLASS     TINSTANCE
+%token MDO
 /*#if IPARAM*/
 %token WITH DLET
 /*#endif*/
@@ -1043,6 +1044,7 @@ infixExpb : infixExpa qop '-' exp10b    {$$ = gc4(ap(NEG,ap(ap($2,$1),$4)));}
           ;
 exp10a    : CASEXP exp OF '{' alts end  {$$ = gc6(ap(CASE,pair($2,rev($5))));}
           | DO '{' stmts end            {$$ = gc4(ap(DOCOMP,checkDo($3)));}
+          | MDO '{' stmts end           {$$ = gc4(ap(DOCOMP,checkDo($3)));}
           | appExp                      {$$ = $1;}
           ;
 exp10b    : '\\' pats ARROW exp         {$$ = gc4(ap(LAMBDA,      

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 637c15b..2bd85a2 100644 (file)
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.71 $
- * $Date: 2000/04/14 15:18:06 $
+ * $Revision: 1.72 $
+ * $Date: 2000/04/25 17:43:50 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -1918,6 +1918,7 @@ Heap    heapTopSnd;
 Bool    consGC = TRUE;                  /* Set to FALSE to turn off gc from*/
                                         /* C stack; use with extreme care! */
 Long    numCells;
+int     numEnters;
 Int     numGcs;                         /* number of garbage collections   */
 Int     cellsRecovered;                 /* number of cells recovered       */
 

diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h
index 881d273..069d730 100644 (file)
--- a/ghc/interpreter/storage.h
+++ b/ghc/interpreter/storage.h
@@ -10,8 +10,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.h,v $
- * $Revision: 1.43 $
- * $Date: 2000/04/11 16:36:53 $
+ * $Revision: 1.44 $
+ * $Date: 2000/04/25 17:43:50 $
  * ------------------------------------------------------------------------*/
 
 #define DEBUG_STORAGE               /* a moderate level of sanity checking */
@@ -278,7 +278,7 @@ extern  Ptr             cptrOf          ( Cell );
  * ------------------------------------------------------------------------*/
 
 #define TAG_PTR_MIN 200
-#define TAG_PTR_MAX 298
+#define TAG_PTR_MAX 299
 
 #define LETREC       200          /* LETREC     snd :: ([Decl],Exp)        */
 #define COND         201          /* COND       snd :: (Exp,Exp,Exp)       */
@@ -444,6 +444,7 @@ extern  Ptr             cptrOf          ( Cell );
 #define ZTUP4        297          /* snd :: (Cell,(Cell,(Cell,Cell)))      */
 #define ZTUP5        298       /* snd :: (Cell,(Cell,(Cell,(Cell,Cell))))  */
 
+#define MDOCOMP      299          /* MDOCOMP     snd :: (Exp,[Qual])       */
 
 
 /* --------------------------------------------------------------------------

diff --git a/ghc/interpreter/version.h b/ghc/interpreter/version.h
index 60e874a..7d936f6 100644 (file)
--- a/ghc/interpreter/version.h
+++ b/ghc/interpreter/version.h
@@ -13,6 +13,6 @@
 #if MAJOR_RELEASE
 #define HUGS_VERSION "March 2000    "
 #else
-#define HUGS_VERSION "STGHugs-000306"
+#define HUGS_VERSION "STGHugs-000425"
 #endif