From 668e01197062f70f91488345852c354d1abb5039 Mon Sep 17 00:00:00 2001 From: andy Date: Tue, 25 Apr 2000 17:43:50 +0000 Subject: [PATCH] [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 --- ghc/interpreter/connect.h | 5 +++-- ghc/interpreter/hugs.c | 24 ++++++++++++++---------- ghc/interpreter/input.c | 10 ++++++---- ghc/interpreter/interface.c | 5 ++--- ghc/interpreter/output.c | 7 +++++-- ghc/interpreter/parser.y | 6 ++++-- ghc/interpreter/storage.c | 5 +++-- ghc/interpreter/storage.h | 7 ++++--- ghc/interpreter/version.h | 2 +- 9 files changed, 42 insertions(+), 29 deletions(-) diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index 60f453c..3fe4658 100644 --- 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 causes an assertion failure */ diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index e2507bc..13776b5 100644 --- 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 @@ -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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4