* included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.22 $
- * $Date: 2000/03/13 11:37:16 $
+ * $Revision: 1.25 $
+ * $Date: 2000/03/24 14:32:03 $
* ------------------------------------------------------------------------*/
-#include "prelude.h"
+#include "hugsbasictypes.h"
#include "storage.h"
#include "connect.h"
#include "errors.h"
static List local addStgVar ( List,Pair );
static Name currentName; /* Top level name being processed */
+static Int lineNumber = 0; /* previously discarded line number */
/* --------------------------------------------------------------------------
* Translation: Convert input expressions into a less complex language
case AP : fst(e) = translate(fst(e));
+ /* T [id <exp>] ==> T[<exp>]
+ * T [indirect <exp> ] ==> T[<exp>]
+ */
if (fst(e)==nameId || fst(e)==nameInd)
return translate(snd(e));
if (isName(fst(e)) &&
return translate(snd(e));
snd(e) = translate(snd(e));
+
return e;
- case NAME : if (e==nameOtherwise)
+ case NAME :
+
+ /* T [otherwise] ==> True
+ */
+
+ if (e==nameOtherwise)
return nameTrue;
+ /* T [assert] ==> T[assertError "<location info>"]
+ */
+ if (flagAssert && e==nameAssert) {
+ Cell str = errAssert(lineNumber);
+ return (ap(nameAssertError,str));
+ }
+
if (isCfun(e)) {
if (isName(name(e).defn))
return name(e).defn;
mapProc(transPair,snd(rhs));
return rhs;
- default : return translate(snd(rhs)); /* discard line number */
+ default : {
+ Cell tmp;
+ Int prev = lineNumber;
+ lineNumber = intOf(fst(rhs));
+ tmp = translate(snd(rhs)); /* discard line number */
+ lineNumber = prev;
+ return tmp;
+ }
}
}
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
+# 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 );
status = rts_eval_(closureOfVar(v),10000,&result);
- signal(SIGINT,old_ctrlbrk);
+ setBreakAction ( brkOld );
fflush (stderr);
fflush (stdout);
switch (status) {
case PREPREL :
case RESET : freeVars = NIL;
freeFuns = NIL;
+ lineNumber = 0;
freeBegin = mkOffset(0);
break;