iris

small scheme interpreter
git clone git://git.2f30.org/iris
Log | Files | Refs | LICENSE

parser.c (16930B)


      1 /* See LICENSE file for copyright and license details. */
      2 #include <stdbool.h>
      3 #include <stdio.h>
      4 #include <stdlib.h>
      5 #include <string.h>
      6 #include "lexer.h"
      7 #include "parser.h"
      8 #include "sym.h"
      9 #include "util.h"
     10 
     11 enum objtype {
     12 	OError = -2,
     13 	OEof = -1,
     14 	OIdentifier,
     15 	OBoolean,
     16 	OInteger,
     17 	OCharacter,
     18 	OString,
     19 	OEmptylist,
     20 	OPair,
     21 	OPrimitiveproc,
     22 	OCompoundproc,
     23 };
     24 
     25 struct object {
     26 	enum objtype type;
     27 	union {
     28 		/* error */
     29 		struct {
     30 			char *s;
     31 		} err;
     32 		/* eof */
     33 		struct {
     34 			char *s;
     35 		} eof;
     36 		/* identifier */
     37 		struct {
     38 			char *name;
     39 		} i;
     40 		/* boolean */
     41 		struct {
     42 			bool v;
     43 		} b;
     44 		/* integer */
     45 		struct {
     46 			long v;
     47 		} n;
     48 		/* character */
     49 		struct {
     50 			char c;
     51 		} c;
     52 		/* string */
     53 		struct {
     54 			char *s;
     55 		} s;
     56 		/* pair */
     57 		struct {
     58 			struct object *car;
     59 			struct object *cdr;
     60 		} pair;
     61 		/* proc */
     62 		struct {
     63 			struct object *(*fn)(struct object *);
     64 		} pproc;
     65 		/* compound procedures */
     66 		struct {
     67 			struct object *params;
     68 			struct object *body;
     69 		} cproc;
     70 	} d;
     71 };
     72 
     73 /* builtins */
     74 static struct object *evaldefine(struct object *);
     75 static struct object *evalif(struct object *);
     76 static struct object *evallambda(struct object *);
     77 static struct object *evalok(struct object *);
     78 static struct object *evalquote(struct object *);
     79 static struct object *evalset(struct object *);
     80 
     81 /* primitive procedures */
     82 static struct object *evalboolean(struct object *);
     83 static struct object *evalcar(struct object *);
     84 static struct object *evalcdr(struct object *);
     85 static struct object *evalcons(struct object *);
     86 static struct object *evaldiff(struct object *);
     87 static struct object *evaleq(struct object *);
     88 static struct object *evalgt(struct object *);
     89 static struct object *evalinteger(struct object *);
     90 static struct object *evallt(struct object *);
     91 static struct object *evalnull(struct object *);
     92 static struct object *evalplus(struct object *);
     93 
     94 struct {
     95 	char *name;
     96 	struct object *o;
     97 	struct object *(*fn)(struct object *);
     98 } builtins[] = {
     99 	{ .name = "define", .fn = evaldefine },
    100 	{ .name = "if",     .fn = evalif     },
    101 	{ .name = "lambda", .fn = evallambda },
    102 	{ .name = "ok",     .fn = evalok     },
    103 	{ .name = "quote",  .fn = evalquote  },
    104 	{ .name = "set",    .fn = evalset    },
    105 };
    106 
    107 struct {
    108 	char *name;
    109 	struct object *o;
    110 	struct object *(*fn)(struct object *);
    111 } procs[] = {
    112 	{ .name = "boolean", .fn = evalboolean },
    113 	{ .name = "car",     .fn = evalcar     },
    114 	{ .name = "cdr",     .fn = evalcdr     },
    115 	{ .name = "cons",    .fn = evalcons    },
    116 	{ .name = "diff",    .fn = evaldiff    },
    117 	{ .name = "eq",      .fn = evaleq      },
    118 	{ .name = "gt",      .fn = evalgt      },
    119 	{ .name = "integer", .fn = evalinteger },
    120 	{ .name = "lt",      .fn = evallt      },
    121 	{ .name = "null",    .fn = evalnull    },
    122 	{ .name = "plus",    .fn = evalplus    },
    123 };
    124 
    125 static struct object *
    126 newobject(void)
    127 {
    128 	return ecalloc(1, sizeof(struct object));
    129 }
    130 
    131 static struct object *
    132 error(char *s)
    133 {
    134 	struct object *o;
    135 
    136 	o = newobject();
    137 	o->type = OError;
    138 	o->d.err.s = estrdup(s);
    139 	return o;
    140 }
    141 
    142 static struct object *
    143 eof(void)
    144 {
    145 	struct object *o;
    146 
    147 	o = newobject();
    148 	o->type = OEof;
    149 	o->d.eof.s = "eof";
    150 	return o;
    151 }
    152 
    153 static struct object *
    154 identifier(char *s)
    155 {
    156 	struct object *o;
    157 
    158 	o = newobject();
    159 	o->type = OIdentifier;
    160 	o->d.i.name = estrdup(s);
    161 	return o;
    162 }
    163 
    164 static struct object *
    165 boolean(bool v)
    166 {
    167 	struct object *o;
    168 
    169 	o = newobject();
    170 	o->type = OBoolean;
    171 	o->d.b.v = v;
    172 	return o;
    173 }
    174 
    175 static struct object *
    176 integer(long v)
    177 {
    178 	struct object *o;
    179 
    180 	o = newobject();
    181 	o->type = OInteger;
    182 	o->d.n.v = v;
    183 	return o;
    184 }
    185 
    186 static struct object *
    187 character(char c)
    188 {
    189 	struct object *o;
    190 
    191 	o = newobject();
    192 	o->type = OCharacter;
    193 	o->d.c.c = c;
    194 	return o;
    195 }
    196 
    197 static struct object *
    198 string(char *s)
    199 {
    200 	struct object *o;
    201 
    202 	o = newobject();
    203 	o->type = OString;
    204 	o->d.s.s = estrdup(s);
    205 	return o;
    206 }
    207 
    208 static struct object *
    209 emptylist(void)
    210 {
    211 	struct object *o;
    212 
    213 	o = newobject();
    214 	o->type = OEmptylist;
    215 	return o;
    216 }
    217 
    218 static struct object *
    219 cons(struct object *car, struct object *cdr)
    220 {
    221 	struct object *o;
    222 
    223 	o = newobject();
    224 	o->type = OPair;
    225 	o->d.pair.car = car;
    226 	o->d.pair.cdr = cdr;
    227 	return o;
    228 }
    229 
    230 static struct object *
    231 pair(FILE *in)
    232 {
    233 	struct object *car, *cdr;
    234 	struct tok t;
    235 
    236 	t = gettok(in);
    237 	if (t.type == TRparen)
    238 		return emptylist();
    239 	puttok(t);
    240 	car = sexpression(in);
    241 	t = gettok(in);
    242 	if (t.type != TDot) {
    243 		puttok(t);
    244 		cdr = pair(in);
    245 		return cons(car, cdr);
    246 	}
    247 	cdr = sexpression(in);
    248 	t = gettok(in);
    249 	if (t.type != TRparen)
    250 		return error("missing right parenthesis");
    251 	return cons(car, cdr);
    252 }
    253 
    254 static struct object *
    255 pproc(struct object *(*fn)(struct object *))
    256 {
    257 	struct object *o;
    258 
    259 	o = newobject();
    260 	o->type = OPrimitiveproc;
    261 	o->d.pproc.fn = fn;
    262 	return o;
    263 }
    264 
    265 static struct object *
    266 cproc(struct object *params, struct object *body)
    267 {
    268 	struct object *o;
    269 
    270 	o = newobject();
    271 	o->type = OCompoundproc;
    272 	o->d.cproc.params = params;
    273 	o->d.cproc.body = body;
    274 	return o;
    275 }
    276 
    277 struct object *
    278 sexpression(FILE *in)
    279 {
    280 	struct tok t;
    281 	char *l;
    282 
    283 	t = gettok(in);
    284 	l = lexeme(&t);
    285 	switch (t.type) {
    286 	case TEof:
    287 		return eof();
    288 	case TError:
    289 		return error(l);
    290 	case TIdentifier:
    291 		return identifier(l);
    292 	case TBoolean:
    293 		/* #t or #f */
    294 		return boolean(l[1] == 't' ? true : false);
    295 	case TInteger:
    296 		return integer(strtol(l, 0, 10));
    297 	case TCharacter:
    298 		/* #\c */
    299 		return character(l[2]);
    300 	case TString:
    301 		return string(l);
    302 	case TLparen:
    303 		return pair(in);
    304 	case TQuote:
    305 		return cons(lookupsym("quote"), cons(sexpression(in),
    306 			    emptylist()));
    307 	default:
    308 		return error("unhandled token");
    309 	}
    310 	/* not reachable */
    311 	return NULL;
    312 }
    313 
    314 static struct object *
    315 car(struct object *o)
    316 {
    317 	return o->d.pair.car;
    318 }
    319 
    320 static struct object *
    321 cdr(struct object *o)
    322 {
    323 	return o->d.pair.cdr;
    324 }
    325 
    326 #define caar(obj)   car(car(obj))
    327 #define cadr(obj)   car(cdr(obj))
    328 #define cdar(obj)   cdr(car(obj))
    329 #define cddr(obj)   cdr(cdr(obj))
    330 #define caaar(obj)  car(car(car(obj)))
    331 #define caadr(obj)  car(car(cdr(obj)))
    332 #define cadar(obj)  car(cdr(car(obj)))
    333 #define caddr(obj)  car(cdr(cdr(obj)))
    334 #define cdaar(obj)  cdr(car(car(obj)))
    335 #define cdadr(obj)  cdr(car(cdr(obj)))
    336 #define cddar(obj)  cdr(cdr(car(obj)))
    337 #define cdddr(obj)  cdr(cdr(cdr(obj)))
    338 #define caaaar(obj) car(car(car(car(obj))))
    339 #define caaadr(obj) car(car(car(cdr(obj))))
    340 #define caadar(obj) car(car(cdr(car(obj))))
    341 #define caaddr(obj) car(car(cdr(cdr(obj))))
    342 #define cadaar(obj) car(cdr(car(car(obj))))
    343 #define cadadr(obj) car(cdr(car(cdr(obj))))
    344 #define caddar(obj) car(cdr(cdr(car(obj))))
    345 #define cadddr(obj) car(cdr(cdr(cdr(obj))))
    346 #define cdaaar(obj) cdr(car(car(car(obj))))
    347 #define cdaadr(obj) cdr(car(car(cdr(obj))))
    348 #define cdadar(obj) cdr(car(cdr(car(obj))))
    349 #define cdaddr(obj) cdr(car(cdr(cdr(obj))))
    350 #define cddaar(obj) cdr(cdr(car(car(obj))))
    351 #define cddadr(obj) cdr(cdr(car(cdr(obj))))
    352 #define cdddar(obj) cdr(cdr(cdr(car(obj))))
    353 #define cddddr(obj) cdr(cdr(cdr(cdr(obj))))
    354 
    355 static struct object *
    356 evaldefine(struct object *o)
    357 {
    358 	struct object *var, *val;
    359 
    360 	if (o->type != OPair)
    361 		return NULL;
    362 	if (car(o)->type != OIdentifier)
    363 		return NULL;
    364 	var = cadr(o);
    365 	if (var->type != OIdentifier)
    366 		return error("expected identifier");
    367 	if (!caddr(o))
    368 		return error("expected sexpression");
    369 	val = eval(caddr(o));
    370 	if (val->type == OError)
    371 		return val;
    372 	if (cadddr(o))
    373 		return error("multiple arguments");
    374 	addsym(var->d.i.name, val);
    375 	return lookupsym("ok");
    376 }
    377 
    378 static struct object *
    379 evalif(struct object *o)
    380 {
    381 	struct object *predicate;
    382 
    383 	if (o->type != OPair)
    384 		return NULL;
    385 	if (car(o)->type != OIdentifier)
    386 		return NULL;
    387 	predicate = eval(cadr(o));
    388 	if (predicate->type == OError)
    389 		return predicate;
    390 	if (predicate->type == OBoolean &&
    391 	    predicate->d.b.v == false)
    392 		return eval(cadddr(o));
    393 	return eval(caddr(o));
    394 }
    395 
    396 static struct object *
    397 evallambda(struct object *o)
    398 {
    399 	struct object *params, *body;
    400 
    401 	if (o->type != OPair)
    402 		return NULL;
    403 	if (car(o)->type != OIdentifier)
    404 		return NULL;
    405 	params = cadr(o);
    406 	body = caddr(o);
    407 	return cproc(params, body);
    408 }
    409 
    410 static struct object *
    411 evalok(struct object *o)
    412 {
    413 	if (o->type != OIdentifier)
    414 		return NULL;
    415 	return o;
    416 }
    417 
    418 static struct object *
    419 evalquote(struct object *o)
    420 {
    421 	if (o->type != OPair)
    422 		return NULL;
    423 	if (car(o)->type != OIdentifier)
    424 		return NULL;
    425 	if (caddr(o))
    426 		return error("multiple arguments");
    427 	return cadr(o);
    428 }
    429 
    430 static struct object *
    431 evalset(struct object *o)
    432 {
    433 	struct object *var, *val;
    434 
    435 	if (o->type != OPair)
    436 		return NULL;
    437 	if (car(o)->type != OIdentifier)
    438 		return NULL;
    439 	var = cadr(o);
    440 	if (var->type != OIdentifier)
    441 		return error("expected identifier");
    442 	if (!lookupsym(var->d.i.name))
    443 		return error("unbound identifier");
    444 	if (!caddr(o))
    445 		return error("expected sexpression");
    446 	val = eval(caddr(o));
    447 	if (val->type == OError)
    448 		return val;
    449 	if (cadddr(o))
    450 		return error("multiple arguments");
    451 	addsym(var->d.i.name, val);
    452 	return lookupsym("ok");
    453 }
    454 
    455 static struct object *
    456 evalboolean(struct object *o)
    457 {
    458 	struct object *arg;
    459 
    460 	if (o->type != OPair)
    461 		return NULL;
    462 	if (car(o)->type != OIdentifier)
    463 		return NULL;
    464 	if (caddr(o))
    465 		return error("multiple arguments");
    466 	arg = eval(cadr(o));
    467 	if (arg->type == OError)
    468 		return arg;
    469 	if (arg->type == OBoolean)
    470 		return boolean(true);
    471 	return boolean(false);
    472 }
    473 
    474 static struct object *
    475 evalcar(struct object *o)
    476 {
    477 	struct object *arg;
    478 
    479 	if (o->type != OPair)
    480 		return NULL;
    481 	if (car(o)->type != OIdentifier)
    482 		return NULL;
    483 	if (caddr(o))
    484 		return error("multiple arguments");
    485 	arg = eval(cadr(o));
    486 	if (arg->type == OError)
    487 		return arg;
    488 	if (arg->type != OPair)
    489 		return error("expected pair");
    490 	return car(arg);
    491 }
    492 
    493 static struct object *
    494 evalcdr(struct object *o)
    495 {
    496 	struct object *arg;
    497 
    498 	if (o->type != OPair)
    499 		return NULL;
    500 	if (car(o)->type != OIdentifier)
    501 		return NULL;
    502 	if (caddr(o))
    503 		return error("multiple arguments");
    504 	arg = eval(cadr(o));
    505 	if (arg->type == OError)
    506 		return arg;
    507 	if (arg->type != OPair)
    508 		return error("expected pair");
    509 	return cdr(arg);
    510 }
    511 
    512 static struct object *
    513 evalcons(struct object *o)
    514 {
    515 	if (o->type != OPair)
    516 		return NULL;
    517 	if (car(o)->type != OIdentifier)
    518 		return NULL;
    519 	if (cadddr(o))
    520 		return error("multiple arguments");
    521 	return cons(eval(cadr(o)), eval(caddr(o)));
    522 }
    523 
    524 static struct object *
    525 dodiff(struct object *o, struct object *n)
    526 {
    527 	struct object *arg;
    528 
    529 	if (!car(o))
    530 		return n;
    531 	arg = eval(car(o));
    532 	if (arg->type == OError)
    533 		return arg;
    534 	if (arg->type != OInteger)
    535 		return error("expected integer");
    536 	n->d.n.v -= arg->d.n.v;
    537 	return dodiff(cdr(o), n);
    538 }
    539 
    540 static struct object *
    541 evaldiff(struct object *o)
    542 {
    543 	struct object *n, *newn;
    544 
    545 	if (o->type != OPair)
    546 		return NULL;
    547 	if (car(o)->type != OIdentifier)
    548 		return NULL;
    549 	if (!cadr(o))
    550 		return integer(0);
    551 	n = eval(cadr(o));
    552 	if (n->type == OError)
    553 		return n;
    554 	if (n->type != OInteger)
    555 		return error("expected integer");
    556 	newn = newobject();
    557 	memcpy(newn, n, sizeof(*newn));
    558 	if (!caddr(o)) {
    559 		newn->d.n.v *= -1;
    560 		return newn;
    561 	}
    562 	return dodiff(cddr(o), newn);
    563 }
    564 
    565 static struct object *
    566 evaleq(struct object *o)
    567 {
    568 	struct object *arg1, *arg2;
    569 
    570 	if (o->type != OPair)
    571 		return NULL;
    572 	if (car(o)->type != OIdentifier)
    573 		return NULL;
    574 	if (cadddr(o))
    575 		return error("multiple arguments");
    576 	arg1 = eval(cadr(o));
    577 	if (arg1->type == OError)
    578 		return arg1;
    579 	if (arg1->type != OInteger)
    580 		return error("expected integer");
    581 	arg2 = eval(caddr(o));
    582 	if (arg2->type == OError)
    583 		return arg2;
    584 	if (arg2->type != OInteger)
    585 		return error("expected integer");
    586 	if (arg1->d.n.v == arg2->d.n.v)
    587 		return boolean(true);
    588 	return boolean(false);
    589 }
    590 
    591 static struct object *
    592 evalgt(struct object *o)
    593 {
    594 	struct object *arg1, *arg2;
    595 
    596 	if (o->type != OPair)
    597 		return NULL;
    598 	if (car(o)->type != OIdentifier)
    599 		return NULL;
    600 	if (cadddr(o))
    601 		return error("multiple arguments");
    602 	arg1 = eval(cadr(o));
    603 	if (arg1->type == OError)
    604 		return arg1;
    605 	if (arg1->type != OInteger)
    606 		return error("expected integer");
    607 	arg2 = eval(caddr(o));
    608 	if (arg2->type == OError)
    609 		return arg2;
    610 	if (arg2->type != OInteger)
    611 		return error("expected integer");
    612 	if (arg1->d.n.v > arg2->d.n.v)
    613 		return boolean(true);
    614 	return boolean(false);
    615 }
    616 
    617 static struct object *
    618 evalinteger(struct object *o)
    619 {
    620 	struct object *arg;
    621 
    622 	if (o->type != OPair)
    623 		return NULL;
    624 	if (car(o)->type != OIdentifier)
    625 		return NULL;
    626 	if (caddr(o))
    627 		return error("multiple arguments");
    628 	arg = eval(cadr(o));
    629 	if (arg->type == OError)
    630 		return arg;
    631 	if (arg->type == OInteger)
    632 		return boolean(true);
    633 	return boolean(false);
    634 }
    635 
    636 static struct object *
    637 evallt(struct object *o)
    638 {
    639 	struct object *arg1, *arg2;
    640 
    641 	if (o->type != OPair)
    642 		return NULL;
    643 	if (car(o)->type != OIdentifier)
    644 		return NULL;
    645 	if (cadddr(o))
    646 		return error("multiple arguments");
    647 	arg1 = eval(cadr(o));
    648 	if (arg1->type == OError)
    649 		return arg1;
    650 	if (arg1->type != OInteger)
    651 		return error("expected integer");
    652 	arg2 = eval(caddr(o));
    653 	if (arg2->type == OError)
    654 		return arg2;
    655 	if (arg2->type != OInteger)
    656 		return error("expected integer");
    657 	if (arg1->d.n.v < arg2->d.n.v)
    658 		return boolean(true);
    659 	return boolean(false);
    660 }
    661 
    662 static struct object *
    663 evalnull(struct object *o)
    664 {
    665 	struct object *arg;
    666 
    667 	if (o->type != OPair)
    668 		return NULL;
    669 	if (car(o)->type != OIdentifier)
    670 		return NULL;
    671 	if (caddr(o))
    672 		return error("multiple arguments");
    673 	arg = eval(cadr(o));
    674 	if (arg->type == OError)
    675 		return arg;
    676 	if (arg->type == OEmptylist)
    677 		return boolean(true);
    678 	return boolean(false);
    679 }
    680 
    681 static struct object *
    682 evalplus(struct object *o)
    683 {
    684 	struct object *arg, *args;
    685 	struct object *n;
    686 
    687 	if (o->type != OPair)
    688 		return NULL;
    689 	if (car(o)->type != OIdentifier)
    690 		return NULL;
    691 	args = cdr(o);
    692 	n = integer(0);
    693 	while (args) {
    694 		arg = car(args);
    695 		if (!arg)
    696 			return n;
    697 		arg = eval(arg);
    698 		if (arg->type == OError)
    699 			return arg;
    700 		if (arg->type != OInteger)
    701 			return error("expected integer");
    702 		n->d.n.v += arg->d.n.v;
    703 		args = cdr(args);
    704 	}
    705 	return n;
    706 }
    707 
    708 static struct object *
    709 evalparams(struct object *o)
    710 {
    711 	struct object *params, *pcar, *pcdr;
    712 	struct object *args, *acar, *acdr;
    713 	struct object *tmp;
    714 
    715 	params = car(lookupsym(car(o)->d.i.name));
    716 	args = cdr(o);
    717 	pcdr = params;
    718 	acdr = args;
    719 	while (1) {
    720 		pcar = car(pcdr);
    721 		acar = car(acdr);
    722 		if (!pcar && !acar)
    723 			break;
    724 		if (pcar && !acar)
    725 			return error("not enough arguments");
    726 		if (!pcar && acar)
    727 			return error("too many arguments");
    728 		pcdr = cdr(pcdr);
    729 		acdr = cdr(acdr);
    730 		if (pcar->type != OIdentifier)
    731 			return error("expected udentifier");
    732 		tmp = eval(acar);
    733 		addsym(pcar->d.i.name, tmp);
    734 	}
    735 	return lookupsym("ok");
    736 }
    737 
    738 static struct object *
    739 evalbody(struct object *o)
    740 {
    741 	return eval(cdr(lookupsym(car(o)->d.i.name)));
    742 }
    743 
    744 static struct object *
    745 evalcproc(struct object *o)
    746 {
    747 	struct object *err, *body;
    748 
    749 	if (o->type != OPair)
    750 		return NULL;
    751 
    752 	err = evalparams(o);
    753 	if (err->type == OError)
    754 		return err;
    755 	body = evalbody(o);
    756 	return body;
    757 }
    758 
    759 struct object *
    760 eval(struct object *o)
    761 {
    762 	size_t i;
    763 	struct object *tmp;
    764 
    765 	switch (o->type) {
    766 	case OError:
    767 	case OEof:
    768 	case OBoolean:
    769 	case OInteger:
    770 	case OCharacter:
    771 	case OString:
    772 		/* self-evaluating objects */
    773 		return o;
    774 	case OIdentifier:
    775 		/* evaluate identifiers */
    776 		tmp = lookupsym(o->d.i.name);
    777 		if (!tmp)
    778 			return error("unbound identifier");
    779 		return tmp;
    780 	case OPair:
    781 		/* evaluate builtins and procedures */
    782 		tmp = lookupsym(car(o)->d.i.name);
    783 		if (!tmp)
    784 			return error("unbound identifier");
    785 		switch (tmp->type) {
    786 		case OIdentifier:
    787 			for (i = 0; i < LEN(builtins); i++)
    788 				if (strcmp(tmp->d.i.name, builtins[i].name) == 0)
    789 					return builtins[i].fn(o);
    790 			break;
    791 		case OPrimitiveproc:
    792 			return tmp->d.pproc.fn(o);
    793 		case OCompoundproc:
    794 			pushenv();
    795 			tmp = evalcproc(o);
    796 			popenv();
    797 			return tmp;
    798 		}
    799 		break;
    800 	}
    801 	return error("cannot eval object");
    802 }
    803 
    804 static void
    805 printpair(struct object *o)
    806 {
    807 	print(car(o));
    808 	switch (cdr(o)->type) {
    809 	case OPair:
    810 		putchar(' ');
    811 		printpair(cdr(o));
    812 	case OEmptylist:
    813 		return;
    814 	default:
    815 		putchar(' ');
    816 		putchar('.');
    817 		putchar(' ');
    818 		print(cdr(o));
    819 	}
    820 }
    821 
    822 void
    823 print(struct object *o)
    824 {
    825 	switch (o->type) {
    826 	case OError:
    827 		printf("%s", o->d.err.s);
    828 		break;
    829 	case OEof:
    830 		printf("%s", o->d.eof.s);
    831 		break;
    832 	case OIdentifier:
    833 		printf("%s", o->d.i.name);
    834 		break;
    835 	case OBoolean:
    836 		printf("#%c", o->d.b.v == false ? 'f' : 't');
    837 		break;
    838 	case OInteger:
    839 		printf("%ld", o->d.n.v);
    840 		break;
    841 	case OCharacter:
    842 		printf("#\\%c", o->d.c.c);
    843 		break;
    844 	case OString:
    845 		printf("%s", o->d.s.s);
    846 		break;
    847 	case OEmptylist:
    848 		printf("()");
    849 		break;
    850 	case OPair:
    851 		putchar('(');
    852 		printpair(o);
    853 		putchar(')');
    854 		break;
    855 	case OPrimitiveproc:
    856 		printf("#<primitive procedure>");
    857 		break;
    858 	case OCompoundproc:
    859 		printf("#<compound procedure>");
    860 		break;
    861 	}
    862 }
    863 
    864 int
    865 init(void)
    866 {
    867 	size_t i;
    868 
    869 	initenv();
    870 	/* add builtins */
    871 	for (i = 0; i < LEN(builtins); i++) {
    872 		builtins[i].o = identifier(builtins[i].name);
    873 		addsym(builtins[i].name, builtins[i].o);
    874 	}
    875 	/* add primitive procedures */
    876 	for (i = 0; i < LEN(procs); i++) {
    877 		procs[i].o = pproc(procs[i].fn);
    878 		addsym(procs[i].name, procs[i].o);
    879 	}
    880 	return 0;
    881 }