Commit 9da01c71 authored by sewardj's avatar sewardj

[project @ 1999-03-09 14:51:03 by sewardj]

Many improvements resulting from first attempt to run nofib suite:
-- More libraries (lib/*.hs) brought into operation
-- Prelude error handling and basic I/O improved
-- Changed bytecode immediate value fields so large constant
--   tables can be compiled
-- Fixed bugs: translation of FATBAR, negative floating point
--   literals, strict constructors, handling of CAFs
parent a41d833a
# ----------------------------------------------------------------------------- #
# $Id: Makefile,v 1.5 1999/03/01 14:58:56 sewardj Exp $ #
# $Id: Makefile,v 1.6 1999/03/09 14:51:03 sewardj Exp $ #
# ----------------------------------------------------------------------------- #
TOP = ../..
......@@ -26,17 +26,16 @@ C_SRCS = link.c type.c static.c storage.c derive.c input.c compiler.c subst.c \
translate.c codegen.c lift.c free.c stgSubst.c optimise.c output.c \
hugs.c dynamic.c stg.c
SRC_CC_OPTS = -g -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -Wall -Wstrict-prototypes -D_POSIX_C_SOURCE
SRC_CC_OPTS = -O2 -Winline -g -I$(GHC_DIR)/includes -I$(GHC_DIR)/rts -D__HUGS__ -Wall -Wstrict-prototypes
GHC_LIBS_NEEDED = $(TOP)/ghc/rts/libHSrts.a $(TOP)/ghc/rts/gmp/libgmp.a
GHC_DYN_CBITS_DIR = $(TOP)/ghc/lib/std/cbits
GHC_DYN_CBITS = $(GHC_DYN_CBITS_DIR)/libHS_cbits.so
###all :: parser.c $(GHC_LIBS_NEEDED) $(GHC_DYN_CBITS) hugs Prelude.hs
all :: parser.c $(GHC_LIBS_NEEDED) $(GHC_DYN_CBITS) hugs
### EXTREMELY hacky
hugs: $(C_OBJS) ../rts/Assembler.o ../rts/Disassembler.o ../rts/Evaluator.o ../rts/ForeignCall.o \
hugs: $(C_OBJS) ../rts/Sanity.o ../rts/Assembler.o ../rts/Disassembler.o ../rts/Evaluator.o ../rts/ForeignCall.o ../rts/GC.o \
../rts/Printer.o
$(CC) -o $@ $(CC_OPTS) $^ $(GHC_LIBS_NEEDED) -lbfd -liberty -ldl -lm
......@@ -55,98 +54,12 @@ cleanish:
snapshot:
/bin/rm -f snapshot.tar
tar cvf snapshot.tar Makefile Prelude.hs *.[chy] *-ORIG-* \
tar cvf snapshot.tar Makefile *.[chy] *-ORIG-* \
../rts/Assembler.c ../rts/Evaluator.c ../rts/Disassembler.c \
../rts/ForeignCall.c ../rts/Printer.c \
../includes/options.h ../includes/Assembler.h nHandle.c \
../includes/Assembler.h ../rts/Bytecodes.h
# --------------------------------------------------------------------- #
# Prelude #
# --------------------------------------------------------------------- #
# HPPFLAGS += "-DBEGIN_FOR_HUGS={-"
# HPPFLAGS += "-DEND_FOR_HUGS=-}"
CPPFLAGS += -I$(GHC_DIR)/includes
CPPFLAGS += -D__HUGS__
HPP = gcc -E -P -traditional -xc -DSTD_PRELUDE=0 $(HPPFLAGS) $(CPPFLAGS) -Iprelude -Ilibrary -I.
UNLIT = ../utils/unlit/unlit
# we cleanup by deleting adjacent blank lines - which just happen to be the
# only duplicate adjacent lines in all the files we process
CLEANUP = uniq
# Fiendishly cunning this:
# o PreludeBuiltin.hs contains the BODY of the libraries it requires.
# o All the other libraries just contain the HEAD of the file.
Prelude.hs : $(wildcard prelude/*.hs) $(wildcard library/*.hs) $(wildcard ../lib/*/*.lhs)
echo Building PreludeBuiltin
$(HPP) ../lib/std/PrelHandle.lhs | $(UNLIT) - PrelHandle.unlit
$(HPP) ../lib/std/PrelIOBase.lhs | $(UNLIT) - PrelIOBase.unlit
$(HPP) ../lib/std/PrelException.lhs | $(UNLIT) - PrelException.unlit
$(HPP) ../lib/std/PrelDynamic.lhs | $(UNLIT) - PrelDynamic.unlit
$(HPP) -DBODY ../lib/std/IO.lhs | $(UNLIT) - IO.unlit
$(HPP) -DHEAD ../lib/std/IO.lhs | $(UNLIT) - IO.hs
$(HPP) -DBODY prelude/Prelude.hs | $(CLEANUP) > PreludeBuiltin.hs
$(HPP) -DHEAD prelude/Prelude.hs | $(CLEANUP) > Prelude.hs
$(HPP) -DHEAD library/Array.hs | $(CLEANUP) > Array.hs
$(HPP) -DHEAD library/Char.hs | $(CLEANUP) > Char.hs
$(HPP) -DHEAD library/Ix.hs | $(CLEANUP) > Ix.hs
$(HPP) -DHEAD library/List.hs | $(CLEANUP) > List.hs
$(HPP) -DHEAD library/Maybe.hs | $(CLEANUP) > Maybe.hs
$(HPP) -DHEAD library/Numeric.hs | $(CLEANUP) > Numeric.hs
$(HPP) -DHEAD library/Ratio.hs | $(CLEANUP) > Ratio.hs
$(HPP) -DHEAD library/UnicodePrims.hs| $(CLEANUP) > UnicodePrims.hs
$(HPP) -DHEAD prelude/PreludeIO.hs | $(CLEANUP) > PreludeIO.hs
$(HPP) -DHEAD prelude/PreludeList.hs | $(CLEANUP) > PreludeList.hs
$(HPP) -DHEAD prelude/PreludeText.hs | $(CLEANUP) > PreludeText.hs
$(HPP) -DHEAD prelude/PrelConc.hs | $(CLEANUP) > PrelConc.hs
echo "Building standard libraries"
$(HPP) library/Complex.hs > Complex.hs
$(HPP) library/Monad.hs > Monad.hs
$(HPP) ../lib/std/System.lhs > System.lhs
$(HPP) ../lib/std/Directory.lhs > Directory.lhs
$(HPP) ../lib/std/Locale.lhs > Locale.lhs
$(HPP) ../lib/std/Random.lhs > Random.lhs
$(HPP) ../lib/std/CPUTime.lhs > CPUTime.lhs
$(HPP) ../lib/std/Time.lhs > Time.lhs
echo "And some standard libraries which ain't done yet"
# $(HPP) library/IO.hs > IO.hs
#
echo "Building Hugs-GHC libraries"
$(HPP) ../lib/exts/ST.lhs > ST.lhs
$(HPP) ../lib/misc/Pretty.lhs > Pretty.lhs
$(HPP) ../lib/exts/IOExts.lhs > IOExts.lhs
$(HPP) ../lib/exts/NumExts.lhs > NumExts.lhs
$(HPP) ../lib/exts/Dynamic.lhs > Dynamic.lhs
$(HPP) ../lib/exts/Bits.lhs > Bits.lhs
$(HPP) ../lib/exts/Exception.lhs > Exception.lhs
$(HPP) library/Int.hs > Int.hs
$(HPP) library/Word.hs > Word.hs
$(HPP) ../lib/exts/Addr.lhs > Addr.lhs
$(HPP) ../lib/concurrent/Channel.lhs > Channel.lhs
$(HPP) ../lib/concurrent/ChannelVar.lhs > ChannelVar.lhs
$(HPP) ../lib/concurrent/Concurrent.lhs > Concurrent.lhs
$(HPP) ../lib/concurrent/Merge.lhs > Merge.lhs
$(HPP) ../lib/concurrent/SampleVar.lhs > SampleVar.lhs
$(HPP) ../lib/concurrent/Semaphore.lhs > Semaphore.lhs
echo "And some libraries which ain't converted yet"
# $(HPP) ../lib/exts/Foreign.lhs > Foreign.lhs
#
# $(HPP) ../lib/concurrent/Parallel.lhs > Parallel.lhs
prelclean:
$(RM) Array.hs Dynamic.lhs NumExts.lhs Pretty.lhs
$(RM) Bits.lhs Exception.lhs Numeric.hs Ratio.hs
$(RM) Channel.lhs IOExts.lhs PrelConc.hs ST.lhs
$(RM) ChannelVar.lhs Ix.hs Prelude.hs SampleVar.lhs
$(RM) Char.hs List.hs PreludeBuiltin.hs Semaphore.lhs
$(RM) Complex.hs Maybe.hs PreludeIO.hs System.lhs
$(RM) Concurrent.lhs Merge.lhs PreludeList.hs UnicodePrims.hs
$(RM) Directory.lhs Monad.hs PreludeText.hs
$(RM) Locale.lhs Int.hs IO.hs Addr.lhs Time.lhs Word.hs
$(RM) *.unlit
../includes/Assembler.h ../rts/Bytecodes.h \
lib/*.hs
# --------------------------------------------------------------------- #
......@@ -176,8 +89,6 @@ CLEAN_FILES += parser.c
INSTALL_LIBEXECS = hugs
###clean :: prelclean
depend :: $(LOOPS) $(SRCS_UGNHS)
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: backend.h,v $
* $Revision: 1.2 $
* $Date: 1999/03/01 14:46:42 $
* $Revision: 1.3 $
* $Date: 1999/03/09 14:51:04 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -129,9 +129,6 @@ extern Bool isAtomic ( StgRhs rhs );
extern StgVar mkStgVar ( StgRhs rhs, Cell info );
#define mkSeq(x,y) mkStgCase(mkStgApp(nameForce,singleton(x)),singleton(mkStgDefault(mkStgVar(NIL,NIL),y)))
#define mkStgRep(c) mkChar(c)
/*-------------------------------------------------------------------------*/
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: codegen.c,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:42 $
* $Revision: 1.5 $
* $Date: 1999/03/09 14:51:04 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -636,22 +636,25 @@ Void cgBinds( List binds )
List b;
int i;
//if (lastModule() != modulePrelude) {
// printf("\n\ncgBinds: before ll\n\n" );
// for (b=binds; nonNull(b); b=tl(b)) {
// printStg ( stdout, hd(b) ); printf("\n\n");
// }
//}
#if 0
if (lastModule() != modulePrelude) {
printf("\n\ncgBinds: before ll\n\n" );
for (b=binds; nonNull(b); b=tl(b)) {
printStg ( stdout, hd(b) ); printf("\n\n");
}
}
#endif
binds = liftBinds(binds);
//if (lastModule() != modulePrelude) {
// printf("\n\ncgBinds: after ll\n\n" );
// for (b=binds; nonNull(b); b=tl(b)) {
// printStg ( stdout, hd(b) ); printf("\n\n");
// }
//}
#if 0
if (lastModule() != modulePrelude) {
printf("\n\ncgBinds: after ll\n\n" );
for (b=binds; nonNull(b); b=tl(b)) {
printStg ( stdout, hd(b) ); printf("\n\n");
}
}
#endif
//mapProc(beginTop,binds);
for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
......
......@@ -10,8 +10,8 @@
* in the distribution for details.
*
* $RCSfile: compiler.c,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:43 $
* $Revision: 1.5 $
* $Date: 1999/03/09 14:51:05 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -1500,7 +1500,6 @@ Void evalExp() { /* compile and run input expression */
RevertCAFs();
break;
case Success:
/* Nothing to do */
break;
default:
internal("evalExp: Unrecognised SchedulerStatus");
......@@ -1535,7 +1534,6 @@ Void compileDefns() { /* compile script definitions */
/* a nasty hack. But I don't know an easier way to make */
/* these things appear. */
if (lastModule() == modulePrelude) {
//printf ( "------ Adding cons (:) [] () \n" );
implementCfun ( nameCons, NIL );
implementCfun ( nameNil, NIL );
implementCfun ( nameUnit, NIL );
......@@ -1583,8 +1581,9 @@ Void compileDefns() { /* compile script definitions */
/* binds=revOnto(binds,NIL); *//* ToDo: maintain compilation order?? */
binds = addGlobals(binds);
#if USE_HUGS_OPTIMIZER
mapProc(optimiseBind,binds);
#error optimiser
if (lastModule() != modulePrelude)
mapProc(optimiseTopBind,binds);
#endif
stgCGBinds(binds);
......
......@@ -7,8 +7,8 @@
* in the distribution for details.
*
* $RCSfile: connect.h,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:43 $
* $Revision: 1.5 $
* $Date: 1999/03/09 14:51:05 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -17,7 +17,6 @@
extern Bool haskell98; /* TRUE => Haskell 98 compatibility*/
extern Module modulePrelude;
//extern Module modulePreludeHugs;
/* --------------------------------------------------------------------------
* Primitive constructor functions
......@@ -173,7 +172,7 @@ extern Float whnfFloat; /* float value of term in whnf */
extern Long numCells; /* number of cells allocated */
extern Int numGcs; /* number of garbage collections */
extern Bool broken; /* indicates interrupt received */
/*ToDo?? extern Bool preludeLoaded;*/ /* TRUE => prelude has been loaded */
extern Bool preludeLoaded; /* TRUE => prelude has been loaded */
extern Bool gcMessages; /* TRUE => print GC messages */
extern Bool literateScripts; /* TRUE => default lit scripts */
......
......@@ -7,8 +7,8 @@
* Hugs version 1.4, December 1997
*
* $RCSfile: derive.c,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:44 $
* $Revision: 1.5 $
* $Date: 1999/03/09 14:51:06 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -19,6 +19,7 @@
#include "Assembler.h"
#include "link.h"
#if 0
static Cell varTrue;
static Cell varFalse;
#if DERIVE_ORD
......@@ -64,7 +65,6 @@ static Cell varGt;
#endif
#if DERIVE_SHOW || DERIVE_READ
static Cell varAppend; /* list append */
List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
#endif
#if DERIVE_EQ || DERIVE_IX
static Cell varAnd; /* built-in logical connectives */
......@@ -72,7 +72,9 @@ static Cell varAnd; /* built-in logical connectives */
#if DERIVE_EQ || DERIVE_ORD
static Cell varEq;
#endif
#endif /* 0 */
List cfunSfuns; /* List of (Cfun,[SelectorVar]) */
/* --------------------------------------------------------------------------
* local function prototypes:
......@@ -202,12 +204,12 @@ Type t; { /* for some TUPLE or DATATYPE t */
List cs = tycon(t).defn;
for (; hasCfun(cs); cs=tl(cs)) {
alts = cons(mkAltEq(tycon(t).line,
makeDPats2(hd(cs),name(hd(cs)).arity)),
makeDPats2(hd(cs),userArity(hd(cs)))),
alts);
}
if (cfunOf(hd(tycon(t).defn))!=0) {
alts = cons(pair(cons(WILDCARD,cons(WILDCARD,NIL)),
pair(mkInt(tycon(t).line),varFalse)),alts);
pair(mkInt(tycon(t).line),nameFalse)),alts);
}
alts = rev(alts);
} else { /* special case for tuples */
......@@ -221,12 +223,12 @@ Int line; /* using patterns in pats for lhs */
List pats; { /* arguments */
Cell p = hd(pats);
Cell q = hd(tl(pats));
Cell e = varTrue;
Cell e = nameTrue;
if (isAp(p)) {
e = ap2(varEq,arg(p),arg(q));
e = ap2(nameEq,arg(p),arg(q));
for (p=fun(p), q=fun(q); isAp(p); p=fun(p), q=fun(q)) {
e = ap2(varAnd,ap2(varEq,arg(p),arg(q)),e);
e = ap2(nameAnd,ap2(nameEq,arg(p),arg(q)),e);
}
}
return pair(pats,pair(mkInt(line),e));
......@@ -246,18 +248,18 @@ Type t; { /* for some TUPLE or DATATYPE t */
Cell rhs = NIL;
if (cfunOf(hd(tycon(t).defn))!=0) {
implementConToTag(t);
rhs = ap2(varCompare,
rhs = ap2(nameCompare,
ap(tycon(t).conToTag,u),
ap(tycon(t).conToTag,w));
} else {
rhs = varEQ;
rhs = nameEQ;
}
alts = singleton(pair(doubleton(u,w),pair(mkInt(tycon(t).line),rhs)));
} else if (isTycon(t)) { /* deal with type constrs */
List cs = tycon(t).defn;
for (; hasCfun(cs); cs=tl(cs)) {
alts = cons(mkAltOrd(tycon(t).line,
makeDPats2(hd(cs),name(hd(cs)).arity)),
makeDPats2(hd(cs),userArity(hd(cs)))),
alts);
}
if (cfunOf(hd(tycon(t).defn))!=0) {
......@@ -266,7 +268,7 @@ Type t; { /* for some TUPLE or DATATYPE t */
implementConToTag(t);
alts = cons(pair(doubleton(u,w),
pair(mkInt(tycon(t).line),
ap2(varCompare,
ap2(nameCompare,
ap(tycon(t).conToTag,u),
ap(tycon(t).conToTag,w)))),
alts);
......@@ -283,12 +285,12 @@ Int line; /* using patterns in pats for lhs */
List pats; { /* arguments */
Cell p = hd(pats);
Cell q = hd(tl(pats));
Cell e = varEQ;
Cell e = nameEQ;
if (isAp(p)) {
e = ap2(varCompare,arg(p),arg(q));
e = ap2(nameCompare,arg(p),arg(q));
for (p=fun(p), q=fun(q); isAp(p); p=fun(p), q=fun(q)) {
e = ap3(varCompAux,arg(p),arg(q),e);
e = ap3(nameCompAux,arg(p),arg(q),e);
}
}
......@@ -304,11 +306,11 @@ List pats; { /* arguments */
#if DERIVE_ENUM
List deriveEnum(t) /* Construct definition of enumeration */
Tycon t; {
Int l = tycon(t).line;
Cell x = inventVar();
Cell y = inventVar();
Int l = tycon(t).line;
Cell x = inventVar();
Cell y = inventVar();
Cell first = hd(tycon(t).defn);
Cell last = tycon(t).defn;
Cell last = tycon(t).defn;
if (!isEnumType(t)) {
ERRMSG(l) "Can only derive instances of Enum for enumeration types"
......@@ -324,12 +326,12 @@ Tycon t; {
cons(mkBind("fromEnum", mkVarAlts(l,tycon(t).conToTag)),
cons(mkBind("enumFrom", singleton(pair(singleton(x),
pair(mkInt(l),
ap2(varEnumFromTo,x,last))))),
ap2(nameFromTo,x,last))))),
/* default instance of enumFromTo is good */
cons(mkBind("enumFromThen",singleton(pair(doubleton(x,y),
pair(mkInt(l),
ap3(varEnumFromThenTo,x,y,
ap(COND,triple(ap2(varLe,x,y),
ap3(nameFromThenTo,x,y,
ap(COND,triple(ap2(nameLe,x,y),
last,first))))))),
/* default instance of enumFromThenTo is good */
NIL))));
......@@ -354,7 +356,7 @@ Tycon t; {
} else if (isTycon(t) && cfunOf(hd(tycon(t).defn))==0) {
return mkIxBinds(tycon(t).line,
hd(tycon(t).defn),
name(hd(tycon(t).defn)).arity);
userArity(hd(tycon(t).defn)));
}
ERRMSG(tycon(t).line)
"Can only derive instances of Ix for enumeration or product types"
......@@ -380,21 +382,21 @@ Tycon t; {
Cell c2 = inventVar();
Cell ci = inventVar();
return cons(mkBind("range", singleton(pair(singleton(ap2(mkTuple(2),
c1,c2)), pair(mkInt(l),ap2(varMap,tagToCon,
ap2(varEnumFromTo,ap(conToTag,c1),
c1,c2)), pair(mkInt(l),ap2(nameMap,tagToCon,
ap2(nameFromTo,ap(conToTag,c1),
ap(conToTag,c2))))))),
cons(mkBind("index", singleton(pair(doubleton(ap(ASPAT,pair(b,
ap2(mkTuple(2),c1,c2))),ci),
pair(mkInt(l),ap(COND,
triple(ap2(varInRange,b,ci),
ap2(qvarMinus,ap(conToTag,ci),
triple(ap2(nameInRange,b,ci),
ap2(nameMinus,ap(conToTag,ci),
ap(conToTag,c1)),
ap(varError,mkStr(findText(
ap(nameError,mkStr(findText(
"Ix.index: Index out of range"))))))))),
cons(mkBind("inRange",singleton(pair(doubleton(ap2(mkTuple(2),
c1,c2),ci), pair(mkInt(l),ap2(varAnd,
ap2(varLe,ap(conToTag,c1),ap(conToTag,ci)),
ap2(varLe,ap(conToTag,ci),
c1,c2),ci), pair(mkInt(l),ap2(nameAnd,
ap2(nameLe,ap(conToTag,c1),ap(conToTag,ci)),
ap2(nameLe,ap(conToTag,ci),
ap(conToTag,c2))))))),
/* ToDo: share conToTag ci */
NIL)));
......@@ -438,7 +440,7 @@ Cell ls, us, is; {
List e = NIL;
for (; isAp(ls); ls=fun(ls), us=fun(us), is=fun(is)) {
e = cons(ap(FROMQUAL,pair(arg(is),
ap(varRange,ap2(mkTuple(2),
ap(nameRange,ap2(mkTuple(2),
arg(ls),
arg(us))))),e);
}
......@@ -460,11 +462,11 @@ Cell ls, us, is; {
List xs = NIL;
Cell e = NIL;
for (; isAp(ls); ls=fun(ls), us=fun(us), is=fun(is)) {
xs = cons(ap2(varIndex,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)),xs);
xs = cons(ap2(nameIndex,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)),xs);
}
for (e=hd(xs); nonNull(xs=tl(xs));) {
Cell x = hd(xs);
e = ap2(qvarPlus,x,ap2(varMult,ap(varRangeSize,arg(fun(x))),e));
e = ap2(namePlus,x,ap2(nameMult,ap(nameRangeSize,arg(fun(x))),e));
}
e = singleton(pair(pats,pair(mkInt(line),e)));
return mkBind("index",e);
......@@ -478,10 +480,10 @@ Cell ls, us, is; {
* inRange (X a b c, X p q r) (X x y z)
* = inRange (a,p) x && inRange (b,q) y && inRange (c,r) z
*/
Cell e = ap2(varInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is));
Cell e = ap2(nameInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is));
while (ls=fun(ls), us=fun(us), is=fun(is), isAp(ls)) {
e = ap2(varAnd,
ap2(varInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)),
e = ap2(nameAnd,
ap2(nameInRange,ap2(mkTuple(2),arg(ls),arg(us)),arg(is)),
e);
}
e = singleton(pair(pats,pair(mkInt(line),e)));
......@@ -1004,7 +1006,7 @@ Tycon t; {
/* \ v -> case v of { ...; i -> Ci; ... } */
Void implementTagToCon(t)
Tycon t; {
Tycon t; {
if (isNull(tycon(t).tagToCon)) {
String etxt;
String tyconname;
......@@ -1091,6 +1093,7 @@ Int what; {
Text textPrelude = findText("Prelude");
switch (what) {
case INSTALL :
#if 0
varTrue = mkQVar(textPrelude,findText("True"));
varFalse = mkQVar(textPrelude,findText("False"));
#if DERIVE_ORD
......@@ -1143,6 +1146,7 @@ Int what; {
#if DERIVE_EQ || DERIVE_ORD
varEq = mkQVar(textPrelude,findText("=="));
#endif
#endif /* 0 */
/* deliberate fall through */
case RESET :
diVars = NIL;
......@@ -1157,6 +1161,7 @@ Int what; {
#if DERIVE_SHOW | DERIVE_READ
mark(cfunSfuns);
#endif
#if 0
mark(varTrue);
mark(varFalse);
#if DERIVE_ORD
......@@ -1209,6 +1214,7 @@ Int what; {
#if DERIVE_EQ || DERIVE_ORD
mark(varEq);
#endif
#endif /* 0 */
break;
}
}
......
......@@ -8,8 +8,8 @@
* in the distribution for details.
*
* $RCSfile: hugs.c,v $
* $Revision: 1.4 $
* $Date: 1999/03/01 14:46:45 $
* $Revision: 1.5 $
* $Date: 1999/03/09 14:51:07 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
......@@ -112,7 +112,6 @@ static Bool quiet = FALSE; /* TRUE => don't show progress */
static String scriptName[NUM_SCRIPTS]; /* Script file names */
static Time lastChange[NUM_SCRIPTS]; /* Time of last change to script */
static Bool postponed[NUM_SCRIPTS]; /* Indicates postponed load */
static Int scriptBase; /* Number of scripts in Prelude */
static Int numScripts; /* Number of scripts loaded */
static Int namesUpto; /* Number of script names set */
static Bool needsImports; /* set to TRUE if imports required */
......@@ -126,8 +125,9 @@ static String lastEdit = 0; /* Name of script to edit (if any) */
static Int lastEdLine = 0; /* Editor line number (if possible)*/
static String prompt = 0; /* Prompt string */
static Int hpSize = DEFAULTHEAP; /* Desired heap size */
String hugsEdit = 0; /* String for editor command */
String hugsPath = 0; /* String for file search path */
String hugsEdit = 0; /* String for editor command */
String hugsPath = 0; /* String for file search path */
Bool preludeLoaded = FALSE;
#if REDIRECT_OUTPUT
static Bool disableOutput = FALSE; /* redirect output to buffer? */
......@@ -216,7 +216,7 @@ String argv[]; {
readOptions(readRegString(HKEY_LOCAL_MACHINE,HugsRoot,"Options",""));
readOptions(readRegString(HKEY_CURRENT_USER, HugsRoot,"Options",""));
#endif /* USE_REGISTRY */
readOptions(fromEnv("HUGSFLAGS",""));
readOptions(fromEnv("STGHUGSFLAGS",""));
startupHaskell ( argc, argv );
argc = prog_argc; argv = prog_argv;
......@@ -262,7 +262,6 @@ String argv[]; {
loadProject(strCopy(proj));
}
readScripts(0);
scriptBase = numScripts;
}
/* --------------------------------------------------------------------------
......@@ -483,7 +482,7 @@ String s; { /* return FALSE if none found. */
case 'h' : setHeapSize(s+1);
return TRUE;
case 'd' : /* hack */
case 'D' : /* hack */
{
extern void setRtsFlags( int x );
setRtsFlags(argToInt(s+1));
......@@ -701,7 +700,7 @@ String s; {
currProject = s;
projInput(currProject);
scriptFile = currProject;
forgetScriptsFrom(scriptBase);
forgetScriptsFrom(1);
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
if (namesUpto<=1) {
......@@ -764,6 +763,7 @@ ToDo: reinstate
}
#endif
scriptFile = 0;
preludeLoaded = TRUE;
return TRUE;
}
......@@ -822,7 +822,7 @@ Script scno; {
for (i=scno; i<namesUpto; ++i)
if (scriptName[i])
free(scriptName[i]);
dropScriptsFrom(scno);
dropScriptsFrom(scno-1);
namesUpto = scno;
if (numScripts>namesUpto)
numScripts = scno;
......@@ -837,7 +837,7 @@ static Void local load() { /* read filenames from command line */
/* to be read */
while ((s=readFilename())!=0)
addScriptName(s,TRUE);
readScripts(scriptBase);
readScripts(1);
}