Commit 42d2afc5 authored by sewardj's avatar sewardj

[project @ 2000-03-10 14:53:00 by sewardj]

Compilation cleanups:
* Add some prototypes to header files, to avoid compilation warnings.
* Remove irrelevant #ifdeffery (#if NPLUSK, + various others)
parent 783f2c36
......@@ -7,8 +7,8 @@
* 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 $
* ------------------------------------------------------------------------*/
......@@ -79,18 +79,9 @@
/* --------------------------------------------------------------------------
* 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
......@@ -100,43 +91,30 @@
#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
......@@ -150,7 +128,7 @@
* 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.
......@@ -192,14 +170,6 @@
*/
#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
......@@ -288,11 +258,6 @@
*/
#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)
......@@ -301,9 +266,6 @@
/* 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
......
......@@ -9,8 +9,8 @@
* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -165,14 +165,12 @@ extern Void optimiseBind Args((StgVar));
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 );
......
......@@ -11,8 +11,8 @@
* 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"
......@@ -619,9 +619,7 @@ Cell pat; { /* test with pat. */
case STRCELL :
case CHARCELL :
#if NPLUSK
case ADDPAT :
#endif
case TUPLE :
case NAME : return pat;
......@@ -637,10 +635,8 @@ Cell p; {
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));
......@@ -708,10 +704,8 @@ Cell pat; { /* replaces parts of pattern that do not */
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));
......@@ -811,14 +805,12 @@ List lds; {
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);
......@@ -938,9 +930,7 @@ Cell e; { /* e = expr to transform */
case AP : return pmcPair(co,sc,e);
#if NPLUSK
case ADDPAT :
#endif
#if TREX
case EXT :
#endif
......@@ -1347,10 +1337,8 @@ Cell ma; { /* match, ma. */
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));
......@@ -1391,18 +1379,12 @@ Cell d; {
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");
......@@ -1411,10 +1393,8 @@ Cell d; {
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)))
......
......@@ -8,8 +8,8 @@
* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -42,9 +42,7 @@ extern Name nameIf, nameSel;
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 */
......@@ -76,10 +74,8 @@ extern Text textPrelude;
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 */
......@@ -555,6 +551,8 @@ extern Void getFileSize Args((String, Long *));
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,
......@@ -568,3 +566,8 @@ extern Cell parseInterface Args((String,Long));
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));
......@@ -7,8 +7,8 @@
* 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"
......@@ -24,8 +24,6 @@
/*#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
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -96,9 +96,7 @@ Name namePrint;
Name nameOtherwise;
Name nameUndefined; /* generic undefined value */
#if NPLUSK
Name namePmSub;
#endif
Name namePMFail;
Name nameEqChar;
Name namePmInt;
......@@ -482,9 +480,7 @@ Void linkPrimitiveNames(void) { /* Hook to names defined in Prelude */
nameOtherwise = linkName("otherwise");
nameUndefined = linkName("undefined");
/* pmc */
# if NPLUSK
namePmSub = linkName("hugsprimPmSub");
# endif
/* translator */
nameEqChar = linkName("hugsprimEqChar");
nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
......
......@@ -10,8 +10,8 @@
* 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"
......@@ -392,14 +392,12 @@ Cell e; {
}
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);
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -58,9 +58,7 @@ static Void local checkMems Args((Class,List,Cell));
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));
......@@ -3447,7 +3445,6 @@ Cell p; {
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 */
......@@ -3465,7 +3462,6 @@ Cell p; {
arg(p) = checkPat(l,v);
return p;
}
#endif
return checkApPat(l,0,p);
}
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -556,7 +556,6 @@ StgVar b;
endStgPP(fp);
}
#if 1 /*DEBUG_PRINTER*/
Void ppStg( StgVar v )
{
printStg(stdout,v);
......@@ -598,6 +597,5 @@ extern Void ppStgVars( List vs )
printf("\n");
endStgPP(stdout);
}
#endif
/*-------------------------------------------------------------------------*/
......@@ -9,8 +9,8 @@
* 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"
......@@ -2123,7 +2123,6 @@ register Cell c; {
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
......@@ -2135,11 +2134,6 @@ Cell c;
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) {
......@@ -2363,7 +2357,7 @@ Int depth; {
}
FlushStdout();
}
#endif
Bool isVar(c) /* is cell a VARIDCELL/VAROPCELL ? */
Cell c; { /* also recognises DICTVAR cells */
......
......@@ -10,8 +10,8 @@
* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -249,29 +249,20 @@ extern Ptr cptrOf Args((Cell));
#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) */
......@@ -1071,6 +1062,16 @@ extern Cell getLastExpr Args((Void));
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
......
......@@ -9,8 +9,8 @@
* 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: */
......@@ -100,7 +100,6 @@ extern Bool unify Args((Type,Int,Type,Int));
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));
......
......@@ -10,8 +10,8 @@
* 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"
......@@ -213,7 +213,6 @@ StgExpr failExpr;
Int da = discrArity(discr);
char str[30];
#if NPLUSK
if (whatIs(h) == ADDPAT && argCount == 1) {
/* ADDPAT num dictIntegral
* ==>
......@@ -260,7 +259,6 @@ StgExpr failExpr;
failExpr)),
failExpr));
}
#endif /* NPLUSK */
assert(isName(h) && argCount == 2);
{
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -725,12 +725,10 @@ Cell e; {
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");
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment