* `kernel' language, elimination of pattern matching and translation to
* super combinators (lambda lifting).
*
- * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
- * Haskell Group 1994-99, and is distributed as Open Source software
- * under the Artistic License; see the file "Artistic" that is included
- * in the distribution for details.
+ * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
+ * Yale Haskell Group, and the Oregon Graduate Institute of Science and
+ * Technology, 1994-1999, All rights reserved. It is distributed as
+ * free software under the license in the file "License", which is
+ * included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.7 $
- * $Date: 1999/06/07 17:22:46 $
+ * $Revision: 1.15 $
+ * $Date: 1999/11/22 16:00:21 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "errors.h"
#include "Rts.h" /* for rts_eval and related stuff */
#include "RtsAPI.h" /* for rts_eval and related stuff */
+#include "SchedAPI.h" /* for RevertCAFs */
#include "Schedule.h"
#include "link.h"
case STRCELL :
case BIGCELL :
case CHARCELL : return e;
-
+#if IPARAM
+ case IPVAR : return nameId;
+#endif
case FINLIST : mapOver(translate,snd(e));
return mkConsList(snd(e));
List bs; { /* eliminating pattern matching on */
List newBinds = NIL; /* lhs of bindings. */
for (; nonNull(bs); bs=tl(bs)) {
+#if IPARAM
+ Cell v = fst(hd(bs));
+ while (isAp(v) && fst(v) == nameInd)
+ v = arg(v);
+ fst(hd(bs)) = v;
+ if (isVar(v)) {
+#else
if (isVar(fst(hd(bs)))) {
+#endif
mapProc(transAlt,snd(hd(bs)));
newBinds = cons(hd(bs),newBinds);
}
/* Run thread (and any other runnable threads) */
/* Re-initialise the scheduler - ToDo: do I need this? */
- initScheduler();
+ /* JRS, 991118: on SM's advice, don't call initScheduler every time.
+ This causes an assertion failure in GC.c(revert_dead_cafs)
+ unless doRevertCAFs below is permanently TRUE.
+ */
+ /* initScheduler(); */
#ifdef CRUDE_PROFILING
cp_init();
#endif
- /* ToDo: don't really initScheduler every time. fix */
{
HaskellObj result; /* ignored */
sighandler_t old_ctrlbrk;
SchedulerStatus status;
- old_ctrlbrk = signal(SIGINT, eval_ctrlbrk);
- assert(old_ctrlbrk != SIG_ERR);
- status = rts_eval_(closureOfVar(v),10000,&result);
+ Bool doRevertCAFs = TRUE; /* do not change -- comment above */
+ old_ctrlbrk = signal(SIGINT, eval_ctrlbrk);
+ ASSERT(old_ctrlbrk != SIG_ERR);
+ status = rts_eval_(closureOfVar(v),10000,&result);
signal(SIGINT,old_ctrlbrk);
+ fflush (stderr);
+ fflush (stdout);
switch (status) {
case Deadlock:
case AllBlocked: /* I don't understand the distinction - ADR */
- printf("{Deadlock}");
- RevertCAFs();
+ printf("{Deadlock or Blackhole}");
+ if (doRevertCAFs) RevertCAFs();
break;
case Interrupted:
printf("{Interrupted}");
- RevertCAFs();
+ if (doRevertCAFs) RevertCAFs();
break;
case Killed:
- printf("{Killed}");
- RevertCAFs();
+ printf("{Interrupted or Killed}");
+ if (doRevertCAFs) RevertCAFs();
break;
case Success:
- RevertCAFs();
+ if (doRevertCAFs) RevertCAFs();
break;
default:
internal("evalExp: Unrecognised SchedulerStatus");
}
+ deleteAllThreads();
fflush(stdout);
fflush(stderr);
}
binds = addGlobals(binds);
done();
-#if USE_HUGS_OPTIMIZER
- if (optimise) {
- t = length(binds);
- setGoal("Simplifying",t);
- optimiseTopBinds(binds);
- done();
- }
-#endif
setGoal("Generating code",t);
stgCGBinds(binds);