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()); }