| @@ -7,6 +7,7 @@ · 6 unmodified lines |
| 7 | 7 | #define CDR(x) ( (x)->cdr.o ) |
| 8 | 8 | #define TAG(x) ( (x)->car.c ) |
| 9 | 9 | #define ISNIL(x) ( (x) == &Nil ) |
| 10 | +#define ISTRUE(x) ( (x) == &True ) |
| 10 | 11 | #define TYPE(x) ( TAG(x) & 0x1 ? TAG(x) >> 2 : AA_TPAIR ) |
| 11 | 12 | #define SETTYPE(x,t) ( TAG(x) = (t) << 2 | 1 ) |
| 12 | 13 | #define NUMBER(x) ( (x)->cdr.n ) |
| @@ -51,12 +52,14 @@ static const char *primnames[P_MAX] = { · 38 unmodified lines |
| 51 | 52 | "<=", "+", "-", "*", "/", |
| 52 | 53 | }; |
| 53 | 54 | |
| 54 | | −static const char *typenames[] = { |
| 55 | +static const char *typenames[AA_TMAX] = { |
| 55 | 56 | "pair", "free", "nil", "number", "symbol", "string", |
| 56 | | − "func", "macro", "prim", "cfunc", "ptr" |
| 57 | + "func", "macro", "prim", "cfunc", "ptr", "bool", |
| 57 | 58 | }; |
| 58 | 59 | |
| 59 | 60 | aaObject Nil = {{ (void*)(AA_TNIL << 2 | 1) }, { nil }}; |
| 61 | +aaObject False = {{ (void*)(AA_TBOOL << 2 | 1) }, { nil }}; |
| 62 | +aaObject True = {{ (void*)(AA_TBOOL << 2 | 1) }, { nil }}; |
| 60 | 63 | static aaObject rparen; |
| 61 | 64 | |
| 62 | 65 | static aaObject *eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **bind); |
| @@ -295,7 +298,8 @@ aa_cons(aaContext *ctx, aaObject *car, aaObject *cdr) · 232 unmodified lines |
| 295 | 298 | aaObject * |
| 296 | 299 | aa_bool(aaContext *ctx, int b) |
| 297 | 300 | { |
| 298 | | − return b ? ctx->t : &Nil; |
| 301 | + USED(ctx); |
| 302 | + return b ? &True : &False; |
| 299 | 303 | } |
| 300 | 304 | |
| 301 | 305 | aaObject * |
| @@ -463,6 +467,10 @@ aa_write(aaContext *ctx, aaObject *obj, aaWriteFn fn, void *udata, int qt) · 161 unmodified lines |
| 463 | 467 | fn(ctx, udata, '"'); |
| 464 | 468 | break; |
| 465 | 469 | |
| 470 | + case AA_TBOOL: |
| 471 | + writestr(ctx, fn, udata, ISTRUE(obj) ? "#t" : "#f"); |
| 472 | + break; |
| 473 | + |
| 466 | 474 | default: |
| 467 | 475 | sprint(buf, "[%s %p]", typenames[TYPE(obj)], (void*)obj); |
| 468 | 476 | writestr(ctx, fn, udata, buf); |
| @@ -814,7 +822,8 @@ eval(aaContext *ctx, aaObject *obj, aaObject *env, aaObject **newenv) · 345 unmodified lines |
| 814 | 822 | break; |
| 815 | 823 | |
| 816 | 824 | case P_NOT: |
| 817 | | − res = aa_bool(ctx, ISNIL(evalarg())); |
| 825 | + va = checktype(ctx, evalarg(), AA_TBOOL); |
| 826 | + res = aa_bool(ctx, !ISTRUE(va)); |
| 818 | 827 | break; |
| 819 | 828 | |
| 820 | 829 | case P_EQ: |
| @@ -913,10 +922,6 @@ aa_open(void *ptr, int size, int flags) · 92 unmodified lines |
| 913 | 922 | ctx->freelist = v; |
| 914 | 923 | } |
| 915 | 924 | |
| 916 | | − /* init objects */ |
| 917 | | − ctx->t = aa_symbol(ctx, "t"); |
| 918 | | − aa_set(ctx, ctx->t, ctx->t); |
| 919 | | − |
| 920 | 925 | /* register built in primitives */ |
| 921 | 926 | save = aa_savegc(ctx); |
| 922 | 927 | for(i = 0; i < P_MAX; i++){ |
| @@ -926,6 +931,8 @@ aa_open(void *ptr, int size, int flags) · 3 unmodified lines |
| 926 | 931 | aa_set(ctx, aa_symbol(ctx, primnames[i]), v); |
| 927 | 932 | aa_restoregc(ctx, save); |
| 928 | 933 | } |
| 934 | + aa_set(ctx, aa_symbol(ctx, "#t"), &True); |
| 935 | + aa_set(ctx, aa_symbol(ctx, "#f"), &False); |
| 929 | 936 | |
| 930 | 937 | if((flags & AA_NOSTDIO) == 0){ |
| 931 | 938 | Binit(&ctx->fd[0], 0, OREAD); |