projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2000-03-10 14:53:00 by sewardj]
[ghc-hetmet.git]
/
ghc
/
interpreter
/
compiler.c
diff --git
a/ghc/interpreter/compiler.c
b/ghc/interpreter/compiler.c
index
eda58cb
..
41799cc
100644
(file)
--- a/
ghc/interpreter/compiler.c
+++ b/
ghc/interpreter/compiler.c
@@
-11,8
+11,8
@@
* included in the distribution.
*
* $RCSfile: compiler.c,v $
* included in the distribution.
*
* $RCSfile: compiler.c,v $
- * $Revision: 1.16 $
- * $Date: 1999/12/10 15:59:42 $
+ * $Revision: 1.20 $
+ * $Date: 2000/03/10 14:53:00 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
* ------------------------------------------------------------------------*/
#include "prelude.h"
@@
-94,6
+94,9
@@
static List local addStgVar Args((List,Pair));
static Cell local translate(e) /* Translate expression: */
Cell e; {
static Cell local translate(e) /* Translate expression: */
Cell e; {
+#if 0
+ printf ( "translate: " );print(e,100);printf("\n");
+#endif
switch (whatIs(e)) {
case LETREC : snd(snd(e)) = translate(snd(snd(e)));
return expandLetrec(e);
switch (whatIs(e)) {
case LETREC : snd(snd(e)) = translate(snd(snd(e)));
return expandLetrec(e);
@@
-185,7
+188,8
@@
Cell e; {
nv));
}
nv));
}
- default : fprintf(stderr, "stuff=%d\n",whatIs(e));internal("translate");
+ default : fprintf(stderr, "stuff=%d\n",whatIs(e));
+ internal("translate");
}
return e;
}
}
return e;
}
@@
-205,6
+209,9
@@
Triple tr; { /* triple of expressions. */
static Void local transAlt(e) /* Translate alt: */
Cell e; { /* ([Pat], Rhs) ==> ([Pat], Rhs') */
static Void local transAlt(e) /* Translate alt: */
Cell e; { /* ([Pat], Rhs) ==> ([Pat], Rhs') */
+#if 0
+ printf ( "transAlt: " );print(snd(e),100);printf("\n");
+#endif
snd(e) = transRhs(snd(e));
}
snd(e) = transRhs(snd(e));
}
@@
-612,9
+619,7
@@
Cell pat; { /* test with pat. */
case STRCELL :
case CHARCELL :
case STRCELL :
case CHARCELL :
-#if NPLUSK
case ADDPAT :
case ADDPAT :
-#endif
case TUPLE :
case NAME : return pat;
case TUPLE :
case NAME : return pat;
@@
-630,10
+635,8
@@
Cell p; {
Cell h = getHead(p);
if (h==nameFromInt || h==nameFromInteger || h==nameFromDouble)
return 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)));
else if (whatIs(h)==ADDPAT)
return ap(fun(p),refutePat(arg(p)));
-#endif
#if TREX
else if (isExt(h)) {
Cell pf = refutePat(extField(p));
#if TREX
else if (isExt(h)) {
Cell pf = refutePat(extField(p));
@@
-701,10
+704,8
@@
Cell pat; { /* replaces parts of pattern that do not */
if (h==nameFromInt ||
h==nameFromInteger || h==nameFromDouble)
return WILDCARD;
if (h==nameFromInt ||
h==nameFromInteger || h==nameFromDouble)
return WILDCARD;
-#if NPLUSK
else if (whatIs(h)==ADDPAT)
return pat;
else if (whatIs(h)==ADDPAT)
return pat;
-#endif
#if TREX
else if (isExt(h)) {
Cell pf = matchPat(extField(pat));
#if TREX
else if (isExt(h)) {
Cell pf = matchPat(extField(pat));
@@
-804,14
+805,12
@@
List lds; {
return remPat(snd(pat),nv,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);
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);
case FINLIST : return remPat1(mkConsList(snd(pat)),expr,lds);
@@
-931,9
+930,7
@@
Cell e; { /* e = expr to transform */
case AP : return pmcPair(co,sc,e);
case AP : return pmcPair(co,sc,e);
-#if NPLUSK
case ADDPAT :
case ADDPAT :
-#endif
#if TREX
case EXT :
#endif
#if TREX
case EXT :
#endif
@@
-1340,10
+1337,8
@@
Cell ma; { /* match, ma. */
Cell h = getHead(p);
switch (whatIs(h)) {
case CONFLDS : return fst(snd(p));
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);
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));
#if TREX
case EXT : h = fun(fun(p));
arg(h) = translate(arg(h));
@@
-1384,18
+1379,12
@@
Cell d; {
case CHARCELL : return 0;
#if TREX
case AP : switch (whatIs(fun(d))) {
case CHARCELL : return 0;
#if TREX
case AP : switch (whatIs(fun(d))) {
-#if NPLUSK
case ADDPAT : return 1;
case ADDPAT : return 1;
-#endif
case EXT : return 2;
default : return 0;
}
#else
case EXT : return 2;
default : return 0;
}
#else
-#if NPLUSK
case AP : return (whatIs(fun(d))==ADDPAT) ? 1 : 0;
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");
#endif
}
internal("discrArity");
@@
-1404,10
+1393,8
@@
Cell d; {
static Bool local eqNumDiscr(d1,d2) /* Determine whether two numeric */
Cell d1, d2; { /* descriptors have same value */
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));
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)))
if (isInt(arg(d1)))
return isInt(arg(d2)) && intOf(arg(d1))==intOf(arg(d2));
if (isFloat(arg(d1)))
@@
-1508,7
+1495,6
@@
Void evalExp() { /* compile and run input expression */
fflush (stdout);
switch (status) {
case Deadlock:
fflush (stdout);
switch (status) {
case Deadlock:
- case AllBlocked: /* I don't understand the distinction - ADR */
printf("{Deadlock or Blackhole}");
if (doRevertCAFs) RevertCAFs();
break;
printf("{Deadlock or Blackhole}");
if (doRevertCAFs) RevertCAFs();
break;
@@
-1618,6
+1604,9
@@
static Void local compileGenFunction(n) /* Produce code for internally */
Name n; { /* generated function */
List defs = name(n).defn;
Int arity = length(fst(hd(defs)));
Name n; { /* generated function */
List defs = name(n).defn;
Int arity = length(fst(hd(defs)));
+#if 0
+ printf ( "compGenFn: " );print(defs,100);printf("\n");
+#endif
compiler(RESET);
currentName = n;
mapProc(transAlt,defs);
compiler(RESET);
currentName = n;
mapProc(transAlt,defs);