* included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.24 $
- * $Date: 2000/03/23 14:54:20 $
+ * $Revision: 1.27 $
+ * $Date: 2000/04/11 16:36:53 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
}
case DICTVAR : /* shouldn't really occur */
- assert(0); /* so let's test for it then! ADR */
+ //assert(0); /* so let's test for it then! ADR */
case VARIDCELL :
case VAROPCELL : return addEqn(pat,expr,lds);
/* intentional fall-thru */
case TUPLE : { List ps = getArgs(pat);
+ /* get rid of leading dictionaries in args */
+ if (isName(c) && isCfun(c)) {
+ Int i = numQualifiers(name(c).type);
+ for (; i > 0; i--) ps = tl(ps);
+ }
+
if (nonNull(ps)) {
Cell nv, sel;
Int i;
-
if (isVar(expr) || isName(expr))
nv = expr;
else {
return binds;
}
-typedef void (*sighandler_t)(int);
-void eval_ctrlbrk ( int dunnowhat )
-{
- interruptStgRts();
- /* reinstall the signal handler so that further interrupts which
- happen before the thread can return to the scheduler, lead back
- here rather than invoking the previous break handler. */
- signal(SIGINT, eval_ctrlbrk);
-}
Void evalExp ( void ) { /* compile and run input expression */
/* ToDo: this name (and other names generated during pattern match?)
unless doRevertCAFs below is permanently TRUE.
*/
/* initScheduler(); */
-#ifdef CRUDE_PROFILING
+
+ /* Further comments, JRS 000411.
+ When control returns to Hugs, you have to be pretty careful about
+ the state of the heap. In particular, hugs.c may subsequently call
+ nukeModule() in storage.c, which removes modules from the system.
+ If a module defines a particular data constructor, the relevant
+ info table is also free()d. That gives a problem if there are
+ still closures hanging round in the heap with references to that
+ info table.
+
+ The solution is to firstly to revert CAFs, and then force a major
+ collection in between transitions from the mutation, ie actually
+ running Haskell, and nukeModule. Since major GCs are potentially
+ expensive, we don't want to do one at every call to nukeModule,
+ so the flag nukeModule_needs_major_gc is used to signal when one
+ is needed.
+
+ This all also seems to imply that doRevertCAFs should always
+ be TRUE.
+ */
+
+# ifdef CRUDE_PROFILING
cp_init();
-#endif
+# endif
{
HaskellObj result; /* ignored */
- sighandler_t old_ctrlbrk;
SchedulerStatus status;
Bool doRevertCAFs = TRUE; /* do not change -- comment above */
- old_ctrlbrk = signal(SIGINT, eval_ctrlbrk);
- ASSERT(old_ctrlbrk != SIG_ERR);
+ HugsBreakAction brkOld = setBreakAction ( HugsRtsInterrupt );
+ nukeModule_needs_major_gc = TRUE;
status = rts_eval_(closureOfVar(v),10000,&result);
- signal(SIGINT,old_ctrlbrk);
+ setBreakAction ( brkOld );
fflush (stderr);
fflush (stdout);
switch (status) {