void Expr::partial_eval_primitive_application() {
Expr* lhs = arg1;
Expr* rhs = arg2->drop_i1();
// arg1 and arg2 are now uninitialized space
switch (lhs->type) {
case K:
type = K1;
arg1 = rhs;
arg2 = 0;
break;
case K1:
type = I1;
arg1 = lhs->arg1->dup();
arg2 = 0;
rhs->deref();
break;
case S:
type = S1;
arg1 = rhs;
arg2 = 0;
break;
case S1:
type = S2;
arg1 = lhs->arg1->dup();
arg2 = rhs;
break;
case LazyRead:
lhs->type = S2;
lhs->arg1 = new Expr(S2, I.dup(), new Expr(K1, make_church_char(getchar())));
lhs->arg2 = new Expr(K1, new Expr(LazyRead));
// fall thru
case S2:
//type = A;
arg1 = partial_apply(lhs->arg1->dup(), rhs->dup());
arg2 = partial_apply(lhs->arg2->dup(), rhs);
break;
case Inc:
rhs = rhs->partial_eval();
type = Num;
numeric_arg1 = rhs->to_number() + 1;
if (numeric_arg1 == 0) {
fputs("Runtime error: invalid output format (attempted to apply inc to a non-number)\n", stderr);
exit(3);
}
arg2 = 0;
break;
case Num:
fputs("Runtime error: invalid output format (attempted to apply a number)\n", stderr);
exit(3);
default:
fprintf(stderr, "INTERNAL ERROR: invalid type in partial_eval_primitive_application (%d)\n", lhs->type);
exit(4);
}
lhs->deref();
}
Expr* make_church_char(int ch) {
if (ch < 0 || ch > 256) {
ch = 256;
}
static Expr* cached_church_chars[257] = { KI.dup(), I.dup() };
if (cached_church_chars[ch] == 0) {
cached_church_chars[ch] = new Expr(Expr::S2, SKSK.dup(), make_church_char(ch-1));
}
return cached_church_chars[ch]->dup();
}
// caller loses original ref, gets returned ref
Expr* drop_i1() {
Expr* cur = this;
if (type == I1) {
do {
cur = cur->arg1;
} while (cur->type == I1);
cur = cur->dup();
this->deref();
}
return cur;
}
Expr* parse_expr(Stream* f, int ch, bool i_is_iota) {
switch (ch) {
case '`': case '*':
{
Expr* p = parse_expr(f, f->getch(), ch=='*');
Expr* q = parse_expr(f, f->getch(), ch=='*');
return Expr::partial_apply(p, q);
}
case '(':
return parse_manual_close(f, ')');
case ')':
f->error("Mismatched close-parenthesis!");
case 'k': case 'K':
return K.dup();
case 's': case 'S':
return S.dup();
case 'i':
if (i_is_iota)
return Iota.dup();
// else fall thru
case 'I':
return I.dup();
case '0': case '1':
{
Expr* e = I.dup();
do {
if (ch == '0') {
e = Expr::partial_apply(Expr::partial_apply(e, S.dup()), K.dup());
} else {
e = Expr::partial_apply(S.dup(), Expr::partial_apply(K.dup(), e));
}
ch = f->getch();
} while (ch == '0' || ch == '1');
f->ungetch(ch);
return e;
}
default:
f->error("Invalid character!");
}
return 0;
}
int main(int argc, char** argv) {
Expr* e = I.dup();
for (int i=1; i<argc; ++i) {
if (argv[i][0] == '-') {
switch (argv[i][1]) {
case 0:
e = append_program(e, &File(stdin, "(standard input)"));
break;
case 'b':
setmode(fileno(stdin), O_BINARY);
setmode(fileno(stdout), O_BINARY);
break;
case 'e':
++i;
if (i == argc) {
usage();
}
e = append_program(e, &StringStream(argv[i]));
break;
default:
usage();
}
} else {
FILE* f = fopen(argv[i], "r");
if (!f) {
fprintf(stderr, "Unable to open the file \"%s\".\n", argv[i]);
exit(1);
}
e = append_program(e, &File(f, argv[i]));
}
}
e = Expr::partial_apply(e, new Expr(Expr::LazyRead));
for (;;) {
int ch = church2int(car(e->dup()));
if (ch >= 256)
return ch-256;
putchar(ch);
e = cdr(e);
}
}
Expr* parse_manual_close(Stream* f, int expected_terminator) {
Expr* e = 0;
int peek;
while (peek = f->getch(), peek != ')' && peek != EOF) {
Expr* e2 = parse_expr(f, peek, false);
e = e ? Expr::partial_apply(e, e2) : e2;
}
if (peek != expected_terminator) {
f->error(peek == EOF ? "Premature end of program!" : "Unmatched trailing close-parenthesis!");
}
if (e == 0) {
e = I.dup();
}
return e;
}
static Expr* cdr(Expr* list) {
return Expr::partial_apply(list, KI.dup());
}
