* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
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 */
* 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>
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);
bd = type;
if (whatIs(bd)==QUAL) {
+ printing = FALSE;
clearCurrentFile();
ERRMSG(0) "Unresolved overloading" ETHEN
ERRTEXT "\n*** Type : " ETHEN ERRTYPE(type);
}
#if 1
+ printing = TRUE;
+ numEnters = 0;
if (isProgType(ks,bd)) {
inputExpr = ap(nameRunIO_toplevel,inputExpr);
evalExp();
} 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);
nukeModule(evalMod);
setCurrModule(currMod);
setCurrentFile(currMod);
+ stopAnyPrinting();
}
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;
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();
-
/* --------------------------------------------------------------------------
* Input functions, lexical analysis parsing etc...
*
* 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"
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
startToken();
while (c0!=EOF && !isIn(c0,ZPACE)) {
- if (c0=='"') {
+ if (c0=='"') {
skip();
while (c0!=EOF && c0!='\"') {
Cell c = readAChar(TRUE);
#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;
textDefault = findText("default");
textDeriving = findText("deriving");
textDo = findText("do");
+ textMdo = findText("mdo");
textClass = findText("class");
#if IPARAM
textWith = findText("with");
* 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"
-
/* entirely bogus claims about types of these symbols */
#define Sym(vvv) extern void (vvv);
#define SymX(vvv) /**/
* 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"
case DOCOMP : putStr("do {...}");
break;
+ case MDOCOMP : putStr("do {...}");
+ break;
+
case COMP : putComp(fst(snd(e)),snd(snd(e)));
break;
* 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 $
* ------------------------------------------------------------------------*/
%{
%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*/
;
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,
* 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"
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 */
* 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 */
* ------------------------------------------------------------------------*/
#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) */
#define ZTUP4 297 /* snd :: (Cell,(Cell,(Cell,Cell))) */
#define ZTUP5 298 /* snd :: (Cell,(Cell,(Cell,(Cell,Cell)))) */
+#define MDOCOMP 299 /* MDOCOMP snd :: (Exp,[Qual]) */
/* --------------------------------------------------------------------------
#if MAJOR_RELEASE
#define HUGS_VERSION "March 2000 "
#else
-#define HUGS_VERSION "STGHugs-000306"
+#define HUGS_VERSION "STGHugs-000425"
#endif