* don't treat undefined variables as nil, hide nil instead and produce errors properly * print → display & newline * prelude * aa_symbol_find
Unified · Split
| @@ -40,7 +40,7 @@ typedef struct { · 39 unmodified lines | ||
| 40 | 40 | |
| 41 | 41 | enum { |
| 42 | 42 | P_LET, P_SET, P_IF, P_LAMBDA, P_MAC, P_WHILE, P_QUOTE, P_AND, P_OR, P_BEGIN, P_CONS, |
| 43 | − P_CAR, P_CDR, P_SETCAR, P_SETCDR, P_LIST, P_NOT, P_EQ, P_PRINT, | |
| 43 | + P_CAR, P_CDR, P_SETCAR, P_SETCDR, P_LIST, P_NOT, P_EQ, P_DISPLAY, | |
| 44 | 44 | P_ATOM, P_NUMBER, P_BOOLEAN, |
| 45 | 45 | P_EQN, P_LT, P_GT, P_LTE, P_GTE, P_ADD, P_SUB, P_MUL, P_DIV, |
| 46 | 46 | |
| @@ -49,13 +49,13 @@ enum { · 2 unmodified lines | ||
| 49 | 49 | |
| 50 | 50 | static const char *primnames[P_MAX] = { |
| 51 | 51 | "let", "define", "if", "lambda", "mac", "while", "quote", "and", "or", "begin", "cons", |
| 52 | − "car", "cdr", "setcar", "setcdr", "list", "not", "eq?", "print", | |
| 52 | + "car", "cdr", "setcar", "setcdr", "list", "not", "eq?", "display", | |
| 53 | 53 | "atom?", "number?", "boolean?", |
| 54 | 54 | "=", "<", ">", "<=", ">=", "+", "-", "*", "/", |
| 55 | 55 | }; |
| 56 | 56 | |
| 57 | 57 | static const char *typenames[AA_TMAX] = { |
| 58 | − "pair", "free", "nil", "number", "symbol", "string", | |
| 58 | + "pair", "free", "()", "number", "symbol", "string", | |
| 59 | 59 | "func", "macro", "prim", "cfunc", "ptr", "bool", |
| 60 | 60 | }; |
| 61 | 61 | |
| @@ -64,6 +64,10 @@ aaObject False = {{ (void*)(AA_TBOOL << 2 | 1) }, { nil }}; · 2 unmodified lines | ||
| 64 | 64 | aaObject True = {{ (void*)(AA_TBOOL << 2 | 1) }, { nil }}; |
| 65 | 65 | static aaObject rparen; |
| 66 | 66 | |
| 67 | +static char prelude[] = "\ | |
| 68 | +(define newline (lambda () (display \"\\n\")))\ | |
| 69 | +"; | |
| 70 | + | |
| 67 | 71 | static aaObject *eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **bind); |
| 68 | 72 | |
| 69 | 73 | aaHandlers * |
| @@ -350,16 +354,27 @@ aa_string(aaContext *ctx, const char *str) · 280 unmodified lines | ||
| 350 | 354 | } |
| 351 | 355 | |
| 352 | 356 | aaObject * |
| 353 | −aa_symbol(aaContext *ctx, const char *name) | |
| 357 | +aa_symbol_find(aaContext *ctx, const char *name) | |
| 354 | 358 | { |
| 355 | 359 | aaObject *obj; |
| 356 | 360 | |
| 357 | − /* try to find in symlist */ | |
| 358 | 361 | for(obj = ctx->symlist; !ISNIL(obj); obj = CDR(obj)){ |
| 359 | 362 | if(streq(CAR(CDR(CAR(obj))), name)) |
| 360 | 363 | return CAR(obj); |
| 361 | 364 | } |
| 362 | 365 | |
| 366 | + return nil; | |
| 367 | +} | |
| 368 | + | |
| 369 | +aaObject * | |
| 370 | +aa_symbol(aaContext *ctx, const char *name) | |
| 371 | +{ | |
| 372 | + aaObject *obj; | |
| 373 | + | |
| 374 | + /* try to find it first */ | |
| 375 | + if((obj = aa_symbol_find(ctx, name)) != nil) | |
| 376 | + return obj; | |
| 377 | + | |
| 363 | 378 | /* create new object, push to symlist and return */ |
| 364 | 379 | obj = object(ctx); |
| 365 | 380 | SETTYPE(obj, AA_TSYMBOL); |
| @@ -429,7 +444,7 @@ aa_write(aaContext *ctx, aaObject *obj, aaWriteFn fn, void *udata, int qt) · 63 unmodified lines | ||
| 429 | 444 | |
| 430 | 445 | switch(TYPE(obj)){ |
| 431 | 446 | case AA_TNIL: |
| 432 | − writestr(ctx, fn, udata, "nil"); | |
| 447 | + writestr(ctx, fn, udata, "()"); | |
| 433 | 448 | break; |
| 434 | 449 | |
| 435 | 450 | case AA_TNUMBER: |
| @@ -641,8 +656,6 @@ read_(aaContext *ctx, aaReadFn fn, void *udata) · 205 unmodified lines | ||
| 641 | 656 | n = strtod(buf, &p); /* try to read as number */ |
| 642 | 657 | if(p != buf && strchr(delimiter, *p)) |
| 643 | 658 | return aa_number(ctx, n); |
| 644 | − if(!strcmp(buf, "nil")) | |
| 645 | − return &Nil; | |
| 646 | 659 | return aa_symbol(ctx, buf); |
| 647 | 660 | } |
| 648 | 661 | } |
| @@ -725,8 +738,13 @@ eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **newenv) · 76 unmodified lines | ||
| 725 | 738 | aaObject cl, *va, *vb; |
| 726 | 739 | int n, gc; |
| 727 | 740 | |
| 728 | − if(TYPE(obj) == AA_TSYMBOL) | |
| 729 | − return CDR(getbound(obj, env)); | |
| 741 | + if(TYPE(obj) == AA_TSYMBOL){ | |
| 742 | + arg = getbound(obj, env); | |
| 743 | + res = CDR(arg); | |
| 744 | + if(ISNIL(res)) | |
| 745 | + aa_error(ctx, "unbound variable: %s", STRBUF(CAR(arg))); | |
| 746 | + return res; | |
| 747 | + } | |
| 730 | 748 | if(TYPE(obj) != AA_TPAIR) |
| 731 | 749 | return obj; |
| 732 | 750 | |
| @@ -832,7 +850,9 @@ eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **newenv) · 99 unmodified lines | ||
| 832 | 850 | break; |
| 833 | 851 | |
| 834 | 852 | case P_EQ: |
| 835 | − res = aa_bool(ctx, aa_nextarg(ctx, &arg, 0) == aa_nextarg(ctx, &arg, 0)); | |
| 853 | + va = evalarg(); | |
| 854 | + vb = evalarg(); | |
| 855 | + res = aa_bool(ctx, va == vb); | |
| 836 | 856 | break; |
| 837 | 857 | |
| 838 | 858 | case P_ATOM: |
| @@ -847,13 +867,12 @@ eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **newenv) · 8 unmodified lines | ||
| 847 | 867 | res = aa_bool(ctx, aa_type(ctx, evalarg()) == AA_TBOOL); |
| 848 | 868 | break; |
| 849 | 869 | |
| 850 | − case P_PRINT: | |
| 870 | + case P_DISPLAY: | |
| 851 | 871 | while(!ISNIL(arg)){ |
| 852 | 872 | aa_writefp(ctx, evalarg(), &ctx->fd[1]); |
| 853 | 873 | if(!ISNIL(arg)) |
| 854 | 874 | Bputc(&ctx->fd[1], ' '); |
| 855 | 875 | } |
| 856 | − Bputc(&ctx->fd[1], '\n'); | |
| 857 | 876 | break; |
| 858 | 877 | |
| 859 | 878 | case P_EQN: numcmpop(==); break; |
| @@ -907,12 +926,19 @@ aa_eval(aaContext *ctx, aaObject *obj) · 47 unmodified lines | ||
| 907 | 926 | return eval(ctx, obj, &Nil, nil); |
| 908 | 927 | } |
| 909 | 928 | |
| 929 | +static int | |
| 930 | +eof(Biobufhdr *, void *, long) | |
| 931 | +{ | |
| 932 | + return 0; | |
| 933 | +} | |
| 934 | + | |
| 910 | 935 | aaContext * |
| 911 | 936 | aa_open(void *ptr, int size, int flags) |
| 912 | 937 | { |
| 913 | 938 | int i, save; |
| 914 | 939 | aaContext *ctx; |
| 915 | 940 | aaObject *v; |
| 941 | + Biobuf b; | |
| 916 | 942 | |
| 917 | 943 | /* init context struct */ |
| 918 | 944 | ctx = ptr; |
| @@ -956,6 +982,15 @@ aa_open(void *ptr, int size, int flags) · 37 unmodified lines | ||
| 956 | 982 | Binit(&ctx->fd[2], 2, OWRITE); |
| 957 | 983 | } |
| 958 | 984 | |
| 985 | + i = strlen(prelude); | |
| 986 | + Binits(&b, -1, OREAD, (uchar*)prelude, i); | |
| 987 | + b.icount = -i; | |
| 988 | + Biofn(&b, eof); | |
| 989 | + while((v = aa_readfp(ctx, &b)) != nil){ | |
| 990 | + aa_eval(ctx, v); | |
| 991 | + aa_restoregc(ctx, save); | |
| 992 | + } | |
| 993 | + | |
| 959 | 994 | return ctx; |
| 960 | 995 | } |
| 961 | 996 | |
| @@ -84,6 +84,7 @@ aaObject *aa_cons(aaContext *ctx, aaObject *car, aaObject *cdr); · 83 unmodified lines | ||
| 84 | 84 | aaObject *aa_bool(aaContext *ctx, int b); |
| 85 | 85 | aaObject *aa_number(aaContext *ctx, aaNumber n); |
| 86 | 86 | aaObject *aa_string(aaContext *ctx, const char *str); |
| 87 | +aaObject *aa_symbol_find(aaContext *ctx, const char *name); | |
| 87 | 88 | aaObject *aa_symbol(aaContext *ctx, const char *name); |
| 88 | 89 | aaObject *aa_cfunc(aaContext *ctx, aaCFunc fn); |
| 89 | 90 | aaObject *aa_ptr(aaContext *ctx, void *ptr); |