* Hugs version 1.4, December 1997
*
* $RCSfile: options.h,v $
- * $Revision: 1.19 $
- * $Date: 2000/03/09 06:14:38 $
+ * $Revision: 1.20 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
- * Making Hugs smaller
+ * Various table sizes
* ------------------------------------------------------------------------*/
-/* Define one of these to select overall size of Hugs
- * SMALL_HUGS for 16 bit operation on a limited memory PC.
- * REGULAR_HUGS for 32 bit operation using largish default table sizes.
- * LARGE_HUGS for 32 bit operation using larger default table sizes.
- */
-#define SMALL_HUGS 0
-#define REGULAR_HUGS 0
-#define LARGE_HUGS 1
-
#define NUM_SYNTAX 100
#define NUM_TUPLES 37
#define NUM_OFFSETS 1024
#endif
#define CHAR_MASK 0xff
-#if SMALL_HUGS /* the McDonalds mentality :-) */
-#define Pick(s,r,l) s
-#endif
-#if REGULAR_HUGS
-#define Pick(s,r,l) r
-#endif
-#if LARGE_HUGS
-#define Pick(s,r,l) l
-#endif
-
-#define MINIMUMHEAP Pick(7500, 19000, 19000)
-#define MAXIMUMHEAP Pick(32765, 0, 0)
-#define DEFAULTHEAP Pick(28000, 50000, 350000)
+#define MINIMUMHEAP 19000
+#define MAXIMUMHEAP 0
+#define DEFAULTHEAP 350000
-#define NUM_SCRIPTS Pick(64, 100, 100)
+#define NUM_SCRIPTS 100
#define NUM_MODULE NUM_SCRIPTS
-#define NUM_TYCON Pick(60, 160, 400)
-#define NUM_NAME Pick(1000, 2000, 16000)
-#define NUM_CLASSES Pick(30, 40, 80)
-#define NUM_INSTS Pick(200, 300, 600)
-#define NUM_TEXT Pick(12000, 20000, 100000)
-#define NUM_TEXTH Pick(1, 10, 10)
-#define NUM_TYVARS Pick(800, 2000, 4000)
-#define NUM_STACK Pick(1800, 12000, 16000)
-#define NUM_DTUPLES Pick(3, 5, 5)
+#define NUM_TYCON 400
+#define NUM_NAME 16000
+#define NUM_CLASSES 80
+#define NUM_INSTS 600
+#define NUM_TEXT 100000
+#define NUM_TEXTH 10
+#define NUM_TYVARS 4000
+#define NUM_STACK 16000
+#define NUM_DTUPLES 5
#define MAXPOSINT 0x7fffffff
#define MINNEGINT (-MAXPOSINT-1)
#define MAXHUGSWORD 0xffffffffU
-#define BIGBASE Pick(100, 10000, 10000)
-#define BIGEXP Pick(2, 4, 4)
-
-#define minRecovery Pick(1000, 1000, 1000)
-#define bitsPerWord Pick(16, 32, 32)
-#define wordShift Pick(4, 5, 5)
-#define wordMask Pick(15, 31, 31)
+#define minRecovery 1000
+#define bitsPerWord 32
+#define wordShift 5
+#define wordMask 31
/* Define to force a fixed size (NUM_TYVARS) for the current substitution.
* Setting this flag places a limit on the maximum complexity of
* extended at a later stage to allow at least some of the tables
* to be extended dynamically at run-time to avoid exhausted space errors.
*/
-#define DYN_TABLES SMALL_HUGS
+#define DYN_TABLES 0
/* Should quantifiers be displayed in error messages.
* Warning: not consistently used.
*/
#define DEFAULT_BIGNUM 1
-/* Are things being used in an interactive setting or a batch setting?
- * In an interactive setting, System.exitWith should not call _exit
- * getProgName and getProgArgs need to be handled differently, etc.
- *
- * Warning: this flag is ignored by an awful lot of code.
- */
-#define INTERACTIVE
-
/* Turn bytecode interpreter support on/off.
*/
#define INTERPRETER 1
*/
#define USE_ADDR_FOR_STRINGS 1
-/* Define to include support for (n+k) patterns.
- * Warning: many people in the Haskell committee want to remove n+k patterns.
- */
-#define NPLUSK 1
-
/* --------------------------------------------------------------------------
* Debugging options (intended for use by maintainers)
/* Define if debugging generated bytecodes or the bytecode interpreter */
#define DEBUG_CODE 1
-/* Define if you want to use a low-level printer from within a debugger */
-#define DEBUG_PRINTER 1
-
/* --------------------------------------------------------------------------
* Experimental features
* These are likely to disappear/change in future versions and should not
* included in the distribution.
*
* $RCSfile: backend.h,v $
- * $Revision: 1.6 $
- * $Date: 1999/11/12 17:32:37 $
+ * $Revision: 1.7 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
Void printStg( FILE *fp, StgVar b);
-#if DEBUG_PRINTER
extern Void ppStg ( StgVar v );
extern Void ppStgExpr ( StgExpr e );
extern Void ppStgRhs ( StgRhs rhs );
extern Void ppStgAlts ( List alts );
extern Void ppStgPrimAlts( List alts );
extern Void ppStgVars ( List vs );
-#endif
extern List liftBinds( List binds );
* included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.19 $
- * $Date: 2000/02/09 14:50:19 $
+ * $Revision: 1.20 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
case STRCELL :
case CHARCELL :
-#if NPLUSK
case ADDPAT :
-#endif
case TUPLE :
case NAME : return pat;
Cell h = getHead(p);
if (h==nameFromInt || h==nameFromInteger || h==nameFromDouble)
return p;
-#if NPLUSK
else if (whatIs(h)==ADDPAT)
return ap(fun(p),refutePat(arg(p)));
-#endif
#if TREX
else if (isExt(h)) {
Cell pf = refutePat(extField(p));
if (h==nameFromInt ||
h==nameFromInteger || h==nameFromDouble)
return WILDCARD;
-#if NPLUSK
else if (whatIs(h)==ADDPAT)
return pat;
-#endif
#if TREX
else if (isExt(h)) {
Cell pf = matchPat(extField(pat));
return remPat(snd(pat),nv,lds);
}
-#if NPLUSK
case ADDPAT : return remPat1(arg(pat), /* n + k = expr */
ap(ap(ap(namePmSub,
arg(fun(pat))),
mkInt(snd(fun(fun(pat))))),
expr),
lds);
-#endif
case FINLIST : return remPat1(mkConsList(snd(pat)),expr,lds);
case AP : return pmcPair(co,sc,e);
-#if NPLUSK
case ADDPAT :
-#endif
#if TREX
case EXT :
#endif
Cell h = getHead(p);
switch (whatIs(h)) {
case CONFLDS : return fst(snd(p));
-#if NPLUSK
case ADDPAT : arg(fun(p)) = translate(arg(fun(p)));
return fun(p);
-#endif
#if TREX
case EXT : h = fun(fun(p));
arg(h) = translate(arg(h));
case CHARCELL : return 0;
#if TREX
case AP : switch (whatIs(fun(d))) {
-#if NPLUSK
case ADDPAT : return 1;
-#endif
case EXT : return 2;
default : return 0;
}
#else
-#if NPLUSK
case AP : return (whatIs(fun(d))==ADDPAT) ? 1 : 0;
-#else
- case AP : return 0; /* must be an Int or Float lit */
-#endif
#endif
}
internal("discrArity");
static Bool local eqNumDiscr(d1,d2) /* Determine whether two numeric */
Cell d1, d2; { /* descriptors have same value */
-#if NPLUSK
if (whatIs(fun(d1))==ADDPAT)
return whatIs(fun(d2))==ADDPAT && snd(fun(d1))==snd(fun(d2));
-#endif
if (isInt(arg(d1)))
return isInt(arg(d2)) && intOf(arg(d1))==intOf(arg(d2));
if (isFloat(arg(d1)))
* included in the distribution.
*
* $RCSfile: connect.h,v $
- * $Revision: 1.24 $
- * $Date: 2000/03/09 02:47:13 $
+ * $Revision: 1.25 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
extern Name nameCompAux;
extern Name namePmInt, namePmFlt; /* primitives for pattern matching */
extern Name namePmInteger;
-#if NPLUSK
extern Name namePmNpk, namePmSub; /* primitives for (n+k) patterns */
-#endif
extern Name nameError; /* For runtime error messages */
extern Name nameUndefined; /* A generic undefined value */
extern Name nameBlackHole; /* For GC-detected black hole */
extern Text textNum; /* used to process default decls */
extern Text textCcall; /* used to process foreign import */
extern Text textStdcall; /* ... and foreign export */
-
-#if NPLUSK
extern Text textPlus; /* Used to recognise n+k patterns */
-#endif
+
#if TREX
extern Name nameNoRec; /* The empty record */
extern Type typeNoRow; /* The empty row */
extern ZPair readInterface Args((String,Long));
extern Bool processInterfaces Args((Void));
+extern void ifLinkConstrItbl ( Name n );
+
extern List /* of ZTriple(I_INTERFACE,
Text--name of obj file,
extern String getExtraObjectInfo ( String primaryObjectName,
String extraFileName,
Int* extraFileSize );
+
+extern Name newDSel Args((Class,Int));
+extern Int visitClass Args((Class));
+
+extern Kind simpleKind Args((Int));
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
- * $Revision: 1.35 $
- * $Date: 2000/03/08 11:20:53 $
+ * $Revision: 1.36 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
/*#define DEBUG_IFACE*/
#define VERBOSE FALSE
-extern void print ( Cell, Int );
-
/* --------------------------------------------------------------------------
* (This comment is now out of date. JRS, 991216).
* The "addGHC*" functions act as "impedence matchers" between GHC
* included in the distribution.
*
* $RCSfile: link.c,v $
- * $Revision: 1.47 $
- * $Date: 2000/03/09 02:47:13 $
+ * $Revision: 1.48 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
Name nameOtherwise;
Name nameUndefined; /* generic undefined value */
-#if NPLUSK
Name namePmSub;
-#endif
Name namePMFail;
Name nameEqChar;
Name namePmInt;
nameOtherwise = linkName("otherwise");
nameUndefined = linkName("undefined");
/* pmc */
-# if NPLUSK
namePmSub = linkName("hugsprimPmSub");
-# endif
/* translator */
nameEqChar = linkName("hugsprimEqChar");
nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
* included in the distribution.
*
* $RCSfile: output.c,v $
- * $Revision: 1.13 $
- * $Date: 1999/11/29 18:59:29 $
+ * $Revision: 1.14 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
}
switch (whatIs(h)) {
-#if NPLUSK
case ADDPAT : if (args==1)
putInfix(d,textPlus,syntaxOf(namePlus),
arg(e),mkInt(intValOf(fun(e))));
else
putStr("ADDPAT");
return;
-#endif
case TUPLE : OPEN(args>tupleOf(h) && d>=FUN_PREC);
putTuple(tupleOf(h),e);
* included in the distribution.
*
* $RCSfile: static.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/03/09 10:19:33 $
+ * $Revision: 1.28 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
static Void local checkMems2 Args((Class,Cell));
static Void local addMembers Args((Class));
static Name local newMember Args((Int,Int,Cell,Type,Class));
- Name newDSel Args((Class,Int));
static Text local generateText Args((String,Class));
- Int visitClass Args((Class));
static List local classBindings Args((String,Class,List));
static Name local memberName Args((Class,Text));
static Cell local checkMaybeCnkPat(l,p)/* Check applicative pattern with */
Int l; /* the possibility of n+k pattern */
Cell p; {
-#if NPLUSK
Cell h = getHead(p);
if (argCount==2 && isVar(h) && textOf(h)==textPlus) { /* n+k */
arg(p) = checkPat(l,v);
return p;
}
-#endif
return checkApPat(l,0,p);
}
* included in the distribution.
*
* $RCSfile: stg.c,v $
- * $Revision: 1.11 $
- * $Date: 2000/02/15 13:16:20 $
+ * $Revision: 1.12 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
endStgPP(fp);
}
-#if 1 /*DEBUG_PRINTER*/
Void ppStg( StgVar v )
{
printStg(stdout,v);
printf("\n");
endStgPP(stdout);
}
-#endif
/*-------------------------------------------------------------------------*/
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.47 $
- * $Date: 2000/03/07 16:18:25 $
+ * $Revision: 1.48 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
return c;*/
}
-#if DEBUG_PRINTER
/* A very, very simple printer.
* Output is uglier than from printExp - but the printer is more
* robust and can be used on any data structure irrespective of
Int depth; {
if (0 == depth) {
Printf("...");
-#if 0 /* Not in this version of Hugs */
- } else if (isPair(c) && !isGenPair(c)) {
- extern Void printEvalCell Args((Cell, Int));
- printEvalCell(c,depth);
-#endif
} else {
Int tag = whatIs(c);
switch (tag) {
}
FlushStdout();
}
-#endif
+
Bool isVar(c) /* is cell a VARIDCELL/VAROPCELL ? */
Cell c; { /* also recognises DICTVAR cells */
* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.31 $
- * $Date: 2000/03/07 16:18:25 $
+ * $Revision: 1.32 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
#define FATBAR 42 /* FATBAR snd :: (Exp,Exp) */
#define LAZYPAT 43 /* LAZYPAT snd :: Exp */
#define DERIVE 45 /* DERIVE snd :: Cell */
-#if BREAK_FLOATS
-#define FLOATCELL 46 /* FLOATCELL snd :: (Int,Int) */
-#endif
-
#define BOOLQUAL 49 /* BOOLQUAL snd :: Exp */
#define QWHERE 50 /* QWHERE snd :: [Decl] */
#define FROMQUAL 51 /* FROMQUAL snd :: (Exp,Exp) */
#define DOQUAL 52 /* DOQUAL snd :: Exp */
#define MONADCOMP 53 /* MONADCOMP snd :: ((m,m0),(Exp,[Qual])*/
-
#define GUARDED 54 /* GUARDED snd :: [guarded exprs] */
-
#define ARRAY 55 /* Array snd :: (Bounds,[Values]) */
#define MUTVAR 56 /* Mutvar snd :: Cell */
-#if INTERNAL_PRIMS
#define HUGSOBJECT 57 /* HUGSOBJECT snd :: Cell */
-#endif
#if IPARAM
#define WITHEXP 58 /* WITHEXP snd :: [(Var,Exp)] */
#endif
-
#define POLYTYPE 60 /* POLYTYPE snd :: (Kind,Type) */
#define QUAL 61 /* QUAL snd :: ([Classes],Type) */
#define RANK2 62 /* RANK2 snd :: (Int,Type) */
extern List addTyconsMatching Args((String,List));
extern List addNamesMatching Args((String,List));
+extern Tycon findTyconInAnyModule ( Text t );
+extern Class findClassInAnyModule ( Text t );
+extern Name findNameInAnyModule ( Text t );
+extern Void print Args((Cell, Int));
+extern void dumpTycon ( Int t );
+extern void dumpName ( Int n );
+extern void dumpClass ( Int c );
+extern void dumpInst ( Int i );
+extern void locateSymbolByName ( Text t );
+
#if LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE(sss) _##sss
#define MAYBE_LEADING_UNDERSCORE_STR(sss) "_" sss
* included in the distribution.
*
* $RCSfile: subst.h,v $
- * $Revision: 1.6 $
- * $Date: 1999/11/17 16:57:50 $
+ * $Revision: 1.7 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
typedef struct { /* Each type variable contains: */
extern Bool kunify Args((Kind,Int,Kind,Int));
extern Void typeTuple Args((Cell));
-extern Kind simpleKind Args((Int));
extern Void varKind Args((Int));
extern Bool samePred Args((Cell,Int,Cell,Int));
* included in the distribution.
*
* $RCSfile: translate.c,v $
- * $Revision: 1.25 $
- * $Date: 2000/03/02 10:10:33 $
+ * $Revision: 1.26 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
Int da = discrArity(discr);
char str[30];
-#if NPLUSK
if (whatIs(h) == ADDPAT && argCount == 1) {
/* ADDPAT num dictIntegral
* ==>
failExpr)),
failExpr));
}
-#endif /* NPLUSK */
assert(isName(h) && argCount == 2);
{
* included in the distribution.
*
* $RCSfile: type.c,v $
- * $Revision: 1.27 $
- * $Date: 2000/03/07 09:34:43 $
+ * $Revision: 1.28 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
case LAZYPAT : snd(e) = typeExpr(l,snd(e));
break;
-#if NPLUSK
case ADDPAT : { Int alpha = newTyvars(1);
inferType(typeVarToVar,alpha);
return ap(e,assumeEvid(predIntegral,alpha));
}
-#endif
default : internal("typeExpr");
}