|
996
|
1 // Lazy K interpreter in C++.
|
|
|
2 // For usage see usage() function below.
|
|
|
3 // Copyright 2002 Ben Rudiak-Gould. Distributed under the GPL.
|
|
|
4 //
|
|
|
5 // Implementation notes:
|
|
|
6 // - When Sxyz is reduced to (xz)(yz), both "copies" of z
|
|
|
7 // point to the same expression tree. When z (or any of
|
|
|
8 // its subexpressions) is reduced, the old tree nodes are
|
|
|
9 // overwritten with their newly reduced versions, so that
|
|
|
10 // any other pointers to the node get the benefit of the
|
|
|
11 // change. This is critical to the performance of any
|
|
|
12 // lazy evaluator. Despite this destructive update, the
|
|
|
13 // meaning (i.e. behavior) of the function described by
|
|
|
14 // any subtree never changes (until the nodes are
|
|
|
15 // garbage-collected and reassigned, that is).
|
|
|
16 // - I actually got stack overflows in the evaluator when
|
|
|
17 // running complicated programs (e.g. prime_numbers.unl
|
|
|
18 // inside the Unlambda interpreter), so I rewrote it to
|
|
|
19 // eliminate recursion from partial_eval() and free().
|
|
|
20 // These functions now use relatively abstruse iterative
|
|
|
21 // algorithms which borrow expression tree pointers for
|
|
|
22 // temporary storage, and restore the original values
|
|
|
23 // where necessary before returning. Other than that, the
|
|
|
24 // interpreter is pretty simple to understand. The only
|
|
|
25 // recursion left (I think) is in the parser and in the
|
|
|
26 // Inc case of partial_eval_primitive_application; the
|
|
|
27 // former will only bite you if you have really deep
|
|
|
28 // nesting in your source code, and the latter only if
|
|
|
29 // you return a ridiculously large number in the output
|
|
|
30 // stream.
|
|
|
31 //
|
|
|
32
|
|
|
33
|
|
|
34 #include <stdio.h>
|
|
|
35 #include <fcntl.h>
|
|
|
36 #include <stdlib.h>
|
|
|
37 #include <ctype.h>
|
|
|
38 #include <sys/stat.h>
|
|
|
39 #include <sys/types.h>
|
|
|
40 #include <unistd.h>
|
|
|
41
|
|
|
42 #ifdef __WIN32
|
|
|
43 #include <io.h>
|
|
|
44 #else
|
|
|
45 #define O_BINARY 0
|
|
|
46 #endif
|
|
|
47
|
|
|
48 class Expr {
|
|
|
49 private:
|
|
|
50 int refcnt;
|
|
|
51 union {
|
|
|
52 Expr* arg1;
|
|
|
53 int numeric_arg1;
|
|
|
54 };
|
|
|
55 Expr* arg2;
|
|
|
56
|
|
|
57 static Expr* free_list;
|
|
|
58 static Expr* alloc();
|
|
|
59 void free();
|
|
|
60
|
|
|
61 void partial_eval_primitive_application();
|
|
|
62
|
|
|
63 public:
|
|
|
64 enum Type { A, K, K1, S, S1, S2, I1, LazyRead, Inc, Num, Free } type;
|
|
|
65
|
|
|
66 static void* operator new(size_t) {
|
|
|
67 Expr* result = free_list;
|
|
|
68 if (result) {
|
|
|
69 free_list = result->arg1;
|
|
|
70 return result;
|
|
|
71 } else {
|
|
|
72 return alloc();
|
|
|
73 }
|
|
|
74 }
|
|
|
75
|
|
|
76 // caller keeps original ref plus returned ref
|
|
|
77 Expr* dup() {
|
|
|
78 ++refcnt;
|
|
|
79 return this;
|
|
|
80 }
|
|
|
81 // caller loses original ref
|
|
|
82 void deref() {
|
|
|
83 if (--refcnt == 0) {
|
|
|
84 free();
|
|
|
85 }
|
|
|
86 }
|
|
|
87
|
|
|
88 // caller keeps original ref
|
|
|
89 Type gettype() { return type; }
|
|
|
90
|
|
|
91 // caller loses refs to a1 and a2, gets ref to new object
|
|
|
92 Expr(Type t, Expr* a1 =0, Expr* a2 =0) {
|
|
|
93 refcnt = 1;
|
|
|
94 type = t;
|
|
|
95 arg1 = a1; arg2 = a2;
|
|
|
96 }
|
|
|
97
|
|
|
98 // caller loses original ref, gets returned ref
|
|
|
99 Expr* partial_eval();
|
|
|
100
|
|
|
101 // caller loses original ref, gets returned ref
|
|
|
102 static Expr* partial_apply(Expr* lhs, Expr* rhs) {
|
|
|
103 // You could do something more complicated here,
|
|
|
104 // but I tried it and it didn't seem to improve
|
|
|
105 // execution speed.
|
|
|
106 return new Expr(A, lhs, rhs);
|
|
|
107 }
|
|
|
108
|
|
|
109 // caller loses original ref
|
|
|
110 int to_number() {
|
|
|
111 int result = (type == Num) ? numeric_arg1 : -1;
|
|
|
112 deref();
|
|
|
113 return result;
|
|
|
114 }
|
|
|
115 #if 0
|
|
|
116 void print(Expr*);
|
|
|
117 #endif
|
|
|
118 // caller loses original ref, gets returned ref
|
|
|
119 Expr* drop_i1() {
|
|
|
120 Expr* cur = this;
|
|
|
121 if (type == I1) {
|
|
|
122 do {
|
|
|
123 cur = cur->arg1;
|
|
|
124 } while (cur->type == I1);
|
|
|
125 cur = cur->dup();
|
|
|
126 this->deref();
|
|
|
127 }
|
|
|
128 return cur;
|
|
|
129 }
|
|
|
130 };
|
|
|
131
|
|
|
132
|
|
|
133 Expr* Expr::free_list = 0;
|
|
|
134
|
|
|
135
|
|
|
136 Expr K(Expr::K);
|
|
|
137 Expr S(Expr::S);
|
|
|
138 Expr I(Expr::S2, &K, &K);
|
|
|
139 Expr KI(Expr::K1, &I);
|
|
|
140
|
|
|
141 Expr SI(Expr::S1, &I);
|
|
|
142 Expr KS(Expr::K1, &S);
|
|
|
143 Expr KK(Expr::K1, &K);
|
|
|
144 Expr SKSK(Expr::S2, &KS, &K);
|
|
|
145 Expr SIKS(Expr::S2, &I, &KS);
|
|
|
146 Expr Iota(Expr::S2, &SIKS, &KK);
|
|
|
147
|
|
|
148 Expr Inc(Expr::Inc);
|
|
|
149 Expr Zero(Expr::Num);
|
|
|
150
|
|
|
151
|
|
|
152 Expr* Expr::alloc() {
|
|
|
153 enum { blocksize = 10000 };
|
|
|
154 static Expr* p = 0;
|
|
|
155 static Expr* end = 0;
|
|
|
156 if (p >= end) {
|
|
|
157 p = (Expr*)malloc(blocksize*sizeof(Expr));
|
|
|
158 if (p == 0) {
|
|
|
159 fputs("Out of memory!\n", stderr);
|
|
|
160 exit(2);
|
|
|
161 }
|
|
|
162 end = p + blocksize;
|
|
|
163 }
|
|
|
164 return p++;
|
|
|
165 }
|
|
|
166
|
|
|
167 #if 0
|
|
|
168 void Expr::print(Expr* highlight) {
|
|
|
169 if (this == highlight) {
|
|
|
170 fputs("###", stdout);
|
|
|
171 }
|
|
|
172 switch (type) {
|
|
|
173 case A:
|
|
|
174 putchar('(');
|
|
|
175 arg1->print(highlight);
|
|
|
176 putchar(' ');
|
|
|
177 arg2->print(highlight);
|
|
|
178 putchar(')');
|
|
|
179 break;
|
|
|
180 case K:
|
|
|
181 putchar('K');
|
|
|
182 break;
|
|
|
183 case K1:
|
|
|
184 fputs("[K ", stdout);
|
|
|
185 arg1->print(highlight);
|
|
|
186 putchar(']');
|
|
|
187 break;
|
|
|
188 case S:
|
|
|
189 putchar('S');
|
|
|
190 break;
|
|
|
191 case S1:
|
|
|
192 fputs("[s ", stdout);
|
|
|
193 arg1->print(highlight);
|
|
|
194 putchar(']');
|
|
|
195 break;
|
|
|
196 case S2:
|
|
|
197 fputs("[S ", stdout);
|
|
|
198 arg1->print(highlight);
|
|
|
199 putchar(' ');
|
|
|
200 arg2->print(highlight);
|
|
|
201 putchar(']');
|
|
|
202 break;
|
|
|
203 case I1:
|
|
|
204 putchar('.');
|
|
|
205 arg1->print(highlight);
|
|
|
206 break;
|
|
|
207 case LazyRead:
|
|
|
208 fputs("LazyRead", stdout);
|
|
|
209 break;
|
|
|
210 case Inc:
|
|
|
211 fputs("Inc", stdout);
|
|
|
212 break;
|
|
|
213 case Num:
|
|
|
214 printf("%d", numeric_arg1);
|
|
|
215 break;
|
|
|
216 default:
|
|
|
217 putchar('?');
|
|
|
218 }
|
|
|
219 if (this == highlight) {
|
|
|
220 fputs("###", stdout);
|
|
|
221 }
|
|
|
222 }
|
|
|
223 #endif
|
|
|
224
|
|
|
225 Expr* make_church_char(int ch) {
|
|
|
226 if (ch < 0 || ch > 256) {
|
|
|
227 ch = 256;
|
|
|
228 }
|
|
|
229
|
|
|
230 static Expr* cached_church_chars[257] = { KI.dup(), I.dup() };
|
|
|
231
|
|
|
232 if (cached_church_chars[ch] == 0) {
|
|
|
233 cached_church_chars[ch] = new Expr(Expr::S2, SKSK.dup(), make_church_char(ch-1));
|
|
|
234 }
|
|
|
235 return cached_church_chars[ch]->dup();
|
|
|
236 }
|
|
|
237
|
|
|
238
|
|
|
239 Expr* g_expr;
|
|
|
240
|
|
|
241
|
|
|
242 // This function modifies the object in-place so that
|
|
|
243 // all references to it see the new version.
|
|
|
244
|
|
|
245 void Expr::partial_eval_primitive_application() {
|
|
|
246 Expr* lhs = arg1;
|
|
|
247 Expr* rhs = arg2->drop_i1();
|
|
|
248
|
|
|
249 // arg1 and arg2 are now uninitialized space
|
|
|
250
|
|
|
251 switch (lhs->type) {
|
|
|
252 case K:
|
|
|
253 type = K1;
|
|
|
254 arg1 = rhs;
|
|
|
255 arg2 = 0;
|
|
|
256 break;
|
|
|
257 case K1:
|
|
|
258 type = I1;
|
|
|
259 arg1 = lhs->arg1->dup();
|
|
|
260 arg2 = 0;
|
|
|
261 rhs->deref();
|
|
|
262 break;
|
|
|
263 case S:
|
|
|
264 type = S1;
|
|
|
265 arg1 = rhs;
|
|
|
266 arg2 = 0;
|
|
|
267 break;
|
|
|
268 case S1:
|
|
|
269 type = S2;
|
|
|
270 arg1 = lhs->arg1->dup();
|
|
|
271 arg2 = rhs;
|
|
|
272 break;
|
|
|
273 case LazyRead:
|
|
|
274 lhs->type = S2;
|
|
|
275 lhs->arg1 = new Expr(S2, I.dup(), new Expr(K1, make_church_char(getchar())));
|
|
|
276 lhs->arg2 = new Expr(K1, new Expr(LazyRead));
|
|
|
277 // fall thru
|
|
|
278 case S2:
|
|
|
279 //type = A;
|
|
|
280 arg1 = partial_apply(lhs->arg1->dup(), rhs->dup());
|
|
|
281 arg2 = partial_apply(lhs->arg2->dup(), rhs);
|
|
|
282 break;
|
|
|
283 case Inc:
|
|
|
284 rhs = rhs->partial_eval();
|
|
|
285 type = Num;
|
|
|
286 numeric_arg1 = rhs->to_number() + 1;
|
|
|
287 if (numeric_arg1 == 0) {
|
|
|
288 fputs("Runtime error: invalid output format (attempted to apply inc to a non-number)\n", stderr);
|
|
|
289 exit(3);
|
|
|
290 }
|
|
|
291 arg2 = 0;
|
|
|
292 break;
|
|
|
293 case Num:
|
|
|
294 fputs("Runtime error: invalid output format (attempted to apply a number)\n", stderr);
|
|
|
295 exit(3);
|
|
|
296 default:
|
|
|
297 fprintf(stderr, "INTERNAL ERROR: invalid type in partial_eval_primitive_application (%d)\n", lhs->type);
|
|
|
298 exit(4);
|
|
|
299 }
|
|
|
300 lhs->deref();
|
|
|
301 }
|
|
|
302
|
|
|
303
|
|
|
304 Expr* Expr::partial_eval() {
|
|
|
305 Expr* prev = 0;
|
|
|
306 Expr* cur = this;
|
|
|
307 for (;;) {
|
|
|
308 cur = cur->drop_i1();
|
|
|
309 while (cur->type == A) {
|
|
|
310 Expr* next = cur->arg1->drop_i1();
|
|
|
311 cur->arg1 = prev;
|
|
|
312 prev = cur; cur = next;
|
|
|
313 }
|
|
|
314 if (!prev) {
|
|
|
315 return cur;
|
|
|
316 }
|
|
|
317 Expr* next = cur; cur = prev;
|
|
|
318 prev = cur->arg1;
|
|
|
319 cur->arg1 = next;
|
|
|
320 cur->partial_eval_primitive_application();
|
|
|
321 }
|
|
|
322 }
|
|
|
323
|
|
|
324
|
|
|
325 /*
|
|
|
326 void Expr::free() {
|
|
|
327 if (type != Num) {
|
|
|
328 if (arg1) arg1->deref();
|
|
|
329 if (arg2) arg2->deref();
|
|
|
330 }
|
|
|
331 type = Free;
|
|
|
332 arg1 = free_list;
|
|
|
333 free_list = this;
|
|
|
334 }
|
|
|
335 */
|
|
|
336
|
|
|
337 void Expr::free() {
|
|
|
338 Expr* cur = this;
|
|
|
339 Expr* partially_free_list = 0;
|
|
|
340 for (;;) {
|
|
|
341 while (--cur->refcnt <= 0 && cur->arg1 != 0 && cur->type != Num) {
|
|
|
342 Expr* next = cur->arg1;
|
|
|
343 if (cur->arg2 != 0) {
|
|
|
344 cur->arg1 = partially_free_list;
|
|
|
345 partially_free_list = cur;
|
|
|
346 } else {
|
|
|
347 cur->arg1 = free_list;
|
|
|
348 free_list = cur;
|
|
|
349 }
|
|
|
350 cur = next;
|
|
|
351 }
|
|
|
352 if (partially_free_list == 0) {
|
|
|
353 break;
|
|
|
354 }
|
|
|
355 cur = partially_free_list;
|
|
|
356 partially_free_list = partially_free_list->arg1;
|
|
|
357 cur->arg1 = free_list;
|
|
|
358 free_list = cur;
|
|
|
359 cur = cur->arg2;
|
|
|
360 }
|
|
|
361 }
|
|
|
362
|
|
|
363
|
|
|
364 class Stream {
|
|
|
365 public:
|
|
|
366 virtual int getch() = 0;
|
|
|
367 virtual void ungetch(int ch) = 0;
|
|
|
368 virtual void error(const char* msg) = 0;
|
|
|
369 };
|
|
|
370
|
|
|
371 class File : public Stream {
|
|
|
372 FILE* f;
|
|
|
373 const char* filename;
|
|
|
374 enum { circular_buf_size = 256 };
|
|
|
375 char circular_buf[circular_buf_size];
|
|
|
376 int last_newline, cur_pos;
|
|
|
377 public:
|
|
|
378 File(FILE* _f, const char* _filename) {
|
|
|
379 f = _f; filename = _filename;
|
|
|
380 last_newline = cur_pos = 0;
|
|
|
381 }
|
|
|
382 int getch();
|
|
|
383 void ungetch(int ch);
|
|
|
384 void error(const char* msg);
|
|
|
385 };
|
|
|
386
|
|
|
387 int File::getch() {
|
|
|
388 int ch;
|
|
|
389 do {
|
|
|
390 ch = getc(f);
|
|
|
391 circular_buf[(cur_pos++)%circular_buf_size] = ch;
|
|
|
392 if (ch == '#') {
|
|
|
393 do {
|
|
|
394 ch = getc(f);
|
|
|
395 } while (ch != '\n' && ch != EOF);
|
|
|
396 }
|
|
|
397 if (ch == '\n') {
|
|
|
398 last_newline = cur_pos;
|
|
|
399 }
|
|
|
400 } while (isspace(ch));
|
|
|
401 return ch;
|
|
|
402 }
|
|
|
403
|
|
|
404 void File::ungetch(int ch) {
|
|
|
405 ungetc(ch, f);
|
|
|
406 --cur_pos;
|
|
|
407 }
|
|
|
408
|
|
|
409 void File::error(const char* msg) {
|
|
|
410 fprintf(stderr, "While parsing \"%s\": %s\n", filename, msg);
|
|
|
411 int from;
|
|
|
412 if (cur_pos-last_newline < circular_buf_size) {
|
|
|
413 from = last_newline;
|
|
|
414 } else {
|
|
|
415 from = cur_pos-circular_buf_size+1;
|
|
|
416 fputs("...", stdout);
|
|
|
417 }
|
|
|
418 for (int i=from; i < cur_pos; ++i) {
|
|
|
419 putc(circular_buf[i%circular_buf_size], stderr);
|
|
|
420 }
|
|
|
421 fputs(" <--\n", stderr);
|
|
|
422 exit(1);
|
|
|
423 }
|
|
|
424
|
|
|
425 class StringStream : public Stream {
|
|
|
426 const char* str;
|
|
|
427 const char* p;
|
|
|
428 public:
|
|
|
429 StringStream(const char* s) {
|
|
|
430 str = s; p = s;
|
|
|
431 }
|
|
|
432 int getch() {
|
|
|
433 return *p ? *p++ : EOF;
|
|
|
434 }
|
|
|
435 void ungetch(int ch) {
|
|
|
436 if (ch != EOF) --p;
|
|
|
437 }
|
|
|
438 void error(const char* msg) {
|
|
|
439 fprintf(stderr, "While parsing command line: %s\n%s\n", msg, str);
|
|
|
440 for (const char* q = str+1; q < p; ++q) {
|
|
|
441 putc(' ', stderr);
|
|
|
442 }
|
|
|
443 fputs("^\n", stderr);
|
|
|
444 exit(1);
|
|
|
445 }
|
|
|
446 };
|
|
|
447
|
|
|
448
|
|
|
449 Expr* parse_expr(Stream* f, int ch, bool i_is_iota);
|
|
|
450
|
|
|
451 Expr* parse_manual_close(Stream* f, int expected_terminator);
|
|
|
452
|
|
|
453
|
|
|
454 Expr* parse_expr(Stream* f, int ch, bool i_is_iota) {
|
|
|
455 switch (ch) {
|
|
|
456 case '`': case '*':
|
|
|
457 {
|
|
|
458 Expr* p = parse_expr(f, f->getch(), ch=='*');
|
|
|
459 Expr* q = parse_expr(f, f->getch(), ch=='*');
|
|
|
460 return Expr::partial_apply(p, q);
|
|
|
461 }
|
|
|
462 case '(':
|
|
|
463 return parse_manual_close(f, ')');
|
|
|
464 case ')':
|
|
|
465 f->error("Mismatched close-parenthesis!");
|
|
|
466 case 'k': case 'K':
|
|
|
467 return K.dup();
|
|
|
468 case 's': case 'S':
|
|
|
469 return S.dup();
|
|
|
470 case 'i':
|
|
|
471 if (i_is_iota)
|
|
|
472 return Iota.dup();
|
|
|
473 // else fall thru
|
|
|
474 case 'I':
|
|
|
475 return I.dup();
|
|
|
476 case '0': case '1':
|
|
|
477 {
|
|
|
478 Expr* e = I.dup();
|
|
|
479 do {
|
|
|
480 if (ch == '0') {
|
|
|
481 e = Expr::partial_apply(Expr::partial_apply(e, S.dup()), K.dup());
|
|
|
482 } else {
|
|
|
483 e = Expr::partial_apply(S.dup(), Expr::partial_apply(K.dup(), e));
|
|
|
484 }
|
|
|
485 ch = f->getch();
|
|
|
486 } while (ch == '0' || ch == '1');
|
|
|
487 f->ungetch(ch);
|
|
|
488 return e;
|
|
|
489 }
|
|
|
490 default:
|
|
|
491 f->error("Invalid character!");
|
|
|
492 }
|
|
|
493 return 0;
|
|
|
494 }
|
|
|
495
|
|
|
496
|
|
|
497 Expr* parse_manual_close(Stream* f, int expected_terminator) {
|
|
|
498 Expr* e = 0;
|
|
|
499 int peek;
|
|
|
500 while (peek = f->getch(), peek != ')' && peek != EOF) {
|
|
|
501 Expr* e2 = parse_expr(f, peek, false);
|
|
|
502 e = e ? Expr::partial_apply(e, e2) : e2;
|
|
|
503 }
|
|
|
504 if (peek != expected_terminator) {
|
|
|
505 f->error(peek == EOF ? "Premature end of program!" : "Unmatched trailing close-parenthesis!");
|
|
|
506 }
|
|
|
507 if (e == 0) {
|
|
|
508 e = I.dup();
|
|
|
509 }
|
|
|
510 return e;
|
|
|
511 }
|
|
|
512
|
|
|
513
|
|
|
514 static Expr* car(Expr* list) {
|
|
|
515 return Expr::partial_apply(list, K.dup());
|
|
|
516 }
|
|
|
517
|
|
|
518 static Expr* cdr(Expr* list) {
|
|
|
519 return Expr::partial_apply(list, KI.dup());
|
|
|
520 }
|
|
|
521
|
|
|
522 static int church2int(Expr* church) {
|
|
|
523 Expr* e = Expr::partial_apply(Expr::partial_apply(church, Inc.dup()), Zero.dup());
|
|
|
524 g_expr = e;
|
|
|
525 int result = e->partial_eval()->to_number();
|
|
|
526 if (result == -1) {
|
|
|
527 fputs("Runtime error: invalid output format (result was not a number)\n", stderr);
|
|
|
528 exit(3);
|
|
|
529 }
|
|
|
530 return result;
|
|
|
531 }
|
|
|
532
|
|
|
533
|
|
|
534 Expr* compose(Expr* f, Expr* g) {
|
|
|
535 return new Expr(Expr::S2, new Expr(Expr::K1, f), g);
|
|
|
536 }
|
|
|
537
|
|
|
538
|
|
|
539 Expr* append_program(Expr* old, Stream* stream) {
|
|
|
540 return compose(parse_manual_close(stream, EOF), old);
|
|
|
541 }
|
|
|
542
|
|
|
543
|
|
|
544 void usage() {
|
|
|
545 fputs(
|
|
|
546 "usage: lazy [-b] { -e program | program-file.lazy } *\n"
|
|
|
547 "\n"
|
|
|
548 " -b puts stdin and stdout into binary mode on systems that care\n"
|
|
|
549 " (i.e. Windows)\n"
|
|
|
550 "\n"
|
|
|
551 " -e program takes program code from the command line (like Perl's -e\n"
|
|
|
552 " switch)\n"
|
|
|
553 "\n"
|
|
|
554 " program-file.lazy name of file containing program code\n"
|
|
|
555 "\n"
|
|
|
556 " If more than one -e or filename argument is given, the programs will be\n"
|
|
|
557 " combined by functional composition (but in Unix pipe order, not mathematical-\n"
|
|
|
558 " notation order). If no -e or filename argument is given, the result is a\n"
|
|
|
559 " degenerate composition, i.e. the identity function.\n", stdout);
|
|
|
560 exit(0);
|
|
|
561 }
|
|
|
562
|
|
|
563
|
|
|
564 int main(int argc, char** argv) {
|
|
|
565 Expr* e = I.dup();
|
|
|
566 for (int i=1; i<argc; ++i) {
|
|
|
567 if (argv[i][0] == '-') {
|
|
|
568 switch (argv[i][1]) {
|
|
|
569 case 0:
|
|
|
570 {
|
|
|
571 File f = File(stdin, "(standard input)");
|
|
|
572 e = append_program(e, &f);
|
|
|
573 break;
|
|
|
574 }
|
|
|
575 case 'b':
|
|
|
576 #ifdef __WIN32
|
|
|
577 setmode(fileno(stdin), O_BINARY);
|
|
|
578 setmode(fileno(stdout), O_BINARY);
|
|
|
579 #endif
|
|
|
580 break;
|
|
|
581 case 'e':
|
|
|
582 {
|
|
|
583 ++i;
|
|
|
584 if (i == argc) {
|
|
|
585 usage();
|
|
|
586 }
|
|
|
587 StringStream s = StringStream(argv[i]);
|
|
|
588 e = append_program(e, &s);
|
|
|
589 break;
|
|
|
590 }
|
|
|
591 default:
|
|
|
592 usage();
|
|
|
593 }
|
|
|
594 } else {
|
|
|
595 FILE* f = fopen(argv[i], "r");
|
|
|
596 if (!f) {
|
|
|
597 fprintf(stderr, "Unable to open the file \"%s\".\n", argv[i]);
|
|
|
598 exit(1);
|
|
|
599 }
|
|
|
600 File ff = File(f, argv[i]);
|
|
|
601 e = append_program(e, &ff);
|
|
|
602 }
|
|
|
603 }
|
|
|
604 e = Expr::partial_apply(e, new Expr(Expr::LazyRead));
|
|
|
605 for (;;) {
|
|
|
606 int ch = church2int(car(e->dup()));
|
|
|
607 if (ch >= 256)
|
|
|
608 return ch-256;
|
|
|
609 putchar(ch);
|
|
|
610 e = cdr(e);
|
|
|
611 }
|
|
|
612 }
|
