itty

Sean's Itty Bitty Programming Language
git clone https://code.literati.org/itty.git
Log | Files | Refs | LICENSE

itty.c (14884B)


      1 #include <assert.h>
      2 #include <stdarg.h>
      3 #include <stdint.h>
      4 #include <stdio.h>
      5 #include <stdlib.h>
      6 #include <string.h>
      7 #include <sysexits.h>
      8 
      9 #include <gmp.h>
     10 
     11 #define STACK_SIZE 500
     12 #define CALL_STACK_SIZE 500
     13 
     14 enum type_e { number, function };
     15 
     16 /* PUSH with no incref */
     17 #define PUS(x) do {                             \
     18         if (st->tos >= st->stack_limit)         \
     19             error("Stack overflow.\n");         \
     20         *st->tos++ = (x);                       \
     21     } while (0)
     22 
     23 
     24 /* PUSH with incref */
     25 #define PUSH(x) do {                            \
     26         incref(x);                              \
     27         PUS(x);                                 \
     28     } while (0)
     29 
     30 
     31 #define POP(x) do {                             \
     32         if (st->tos <= st->stack)               \
     33             error("Stack underflow.\n");        \
     34         x = *--st->tos;                         \
     35     } while (0)
     36 
     37 
     38 /* Deal with the return stack */
     39 #define POPRET() do {                           \
     40         if (st->frame <= st->call_stack)        \
     41             error("Call stack underflow.\n");   \
     42         struct frame_st *frame = st->frame--;   \
     43         st->pc = frame->ret;                    \
     44         clear_vars(frame);                      \
     45     } while (0)
     46 
     47 
     48 #define PUSHRET() do {                          \
     49         if (st->frame >= st->call_stack_limit)  \
     50             error("Call stack overflow.\n");    \
     51         struct frame_st *frame = ++st->frame;   \
     52         frame->ret = st->pc;                    \
     53     } while (0)
     54 
     55 
     56 /* Call the function in x. */
     57 #define CALL(x) do {                            \
     58         if (*st->pc != ']') {                   \
     59             PUSHRET();                          \
     60         } else {                                \
     61             struct frame_st *frame = st->frame; \
     62             clear_vars(frame);                  \
     63         }                                       \
     64         st->pc = (x)->data.fun;                 \
     65     } while (0)
     66 
     67 
     68 #define ZERO(x) (mpz_cmp_ui(*to_mpz(x), 0) == 0)
     69 #define NONZERO(x) (!ZERO(x))
     70 
     71 
     72 /* Binary boolean operations on bignums */
     73 #define BINBOOL(op) do {                        \
     74         POP(y);                                 \
     75         POP(x);                                 \
     76         PUSH((op) ? one : zero);                \
     77         decref(y);                              \
     78         decref(x);                              \
     79     } while (0)
     80 
     81 
     82 /* Binary operation on bignums */
     83 #define BINOP(f) do {                           \
     84         POP(y);                                 \
     85         POP(x);                                 \
     86         z = num_new();                          \
     87         f(z->data.mpz, *to_mpz(x), *to_mpz(y)); \
     88         decref(y);                              \
     89         decref(x);                              \
     90         PUS(z);                                 \
     91     } while (0)
     92 
     93 
     94 typedef struct {
     95     int refcnt;
     96     enum type_e type;
     97     union {
     98         mpz_t mpz;
     99         char *fun;
    100     } data;
    101 } obj_t;
    102 
    103 
    104 struct frame_st {
    105     char *ret;
    106     obj_t *vars[26];
    107 };
    108 
    109 
    110 typedef struct {
    111     char *pc;
    112     obj_t **tos;
    113     obj_t **stack_limit;
    114     struct frame_st *call_stack;
    115     struct frame_st *call_stack_limit;
    116     struct frame_st *frame;
    117     obj_t *vars[26];
    118     obj_t *stack[];
    119 } state_t;
    120 
    121 
    122 static obj_t *zero;
    123 static obj_t *one;
    124 
    125 
    126 void error(char *format, ...) {
    127     va_list argp;
    128     va_start(argp, format);
    129     vfprintf(stderr, format, argp);
    130     exit(EX_DATAERR);
    131 }
    132 
    133 
    134 void obj_free(obj_t *o) {
    135     if (o->type == number) mpz_clear(o->data.mpz);
    136     free(o);
    137 }
    138 
    139 
    140 void decref(obj_t *o) {
    141     assert(o->refcnt > 0);
    142     if (--o->refcnt == 0) obj_free(o);
    143 }
    144 
    145 
    146 void incref(obj_t *o) {
    147     assert(o->refcnt > 0);
    148     ++o->refcnt;
    149 }
    150 
    151 
    152 void clear_vars(struct frame_st *frame) {
    153     int i;
    154     for (i = 0; i < 26; ++i) {
    155         if (frame->vars[i] != NULL) {
    156             decref(frame->vars[i]);
    157             frame->vars[i] = NULL;
    158         }
    159     }
    160 }
    161 
    162 
    163 mpz_t *to_mpz(obj_t *o) {
    164     if (o->type != number) error("Argument is not a number.\n");
    165     return &o->data.mpz;
    166 }
    167 
    168 
    169 unsigned long to_ulong(obj_t *o) {
    170     mpz_t *x = to_mpz(o);
    171     unsigned int r = 0;
    172     if (mpz_fits_ulong_p(*x)) {
    173         r = mpz_get_ui(*x);
    174     } else {
    175         error("Argument too big.\n");
    176     }
    177     return r;
    178 }
    179 
    180 
    181 obj_t *obj_new(enum type_e t) {
    182     obj_t *o = malloc(sizeof(*o));
    183     o->refcnt = 1;
    184     o->type = t;
    185     return o;
    186 }
    187 
    188 
    189 obj_t *fun_new(char *f) {
    190     obj_t *o = obj_new(function);
    191     o->data.fun = f;
    192     return o;
    193 }
    194 
    195 
    196 obj_t *num_new() {
    197     obj_t *o = obj_new(number);
    198     mpz_init(o->data.mpz);
    199     return o;
    200 }
    201 
    202 
    203 obj_t *num_new_from_str(char *str) {
    204     obj_t *o = obj_new(number);
    205     mpz_init_set_str(o->data.mpz, str, 10);
    206     return o;
    207 }
    208 
    209 /* Utility functions */
    210 void init() {
    211     zero = num_new_from_str("0");
    212     one = num_new_from_str("1");
    213 }
    214 
    215 /* Debugging */
    216 void print_obj(FILE *fp, obj_t *x) {
    217     switch (x->type) {
    218     case number:
    219         gmp_fprintf(fp, "%Zd", x->data.mpz);
    220         break;
    221     case function:
    222         fprintf(fp, "<fun %p>", x->data.fun);
    223         break;
    224     default:
    225         error("Unrecognized type %d\n", x->type);
    226     }
    227     fflush(stdout);
    228 }
    229 
    230 
    231 void print_stack(state_t *st) {
    232     obj_t **p;
    233     for (p = st->tos-1; p >= st->stack; p--) {
    234         fprintf(stderr, "  %3ld: ", st->tos-p-1);
    235         print_obj(stderr, *p);
    236     }
    237 }
    238 
    239 
    240 void print_vars(obj_t *vars[], int global) {
    241     char startc = global ? 'A' : 'a';
    242     int i;
    243     for (i = 0; i < 26; i++) {
    244         if (vars[i] != NULL && vars[i]->type == number) {
    245             fprintf(stderr, "  %c = ", startc + i);
    246             print_obj(stderr, vars[i]);
    247         }
    248     }
    249 }
    250 
    251 
    252 void print_trace(state_t *st) {
    253     fprintf(stderr, "DEBUG:\nStack:\n");
    254     print_stack(st);
    255     fprintf(stderr, "Global vars:\n");
    256     print_vars(st->vars, 1);
    257     fprintf(stderr, "Local vars:\n");
    258     print_vars(st->frame->vars, 0);
    259     fprintf(stderr, "\n");
    260 }
    261 
    262 
    263 /*
    264  * Interpretation utility functions
    265  */
    266 
    267 /* Skips the closing paren */
    268 char *skip_comment(char *p) {
    269     while (*p && *p++ != ')');
    270     return p;
    271 }
    272 
    273 
    274 /* Leaves you on closing quote */
    275 char *skip_string(char *p) {
    276     while (*p && *p != '"') {
    277         if (*p == '\\') p++; /* Escape */
    278         p++;
    279     }
    280     return p;
    281 }
    282 
    283 
    284 
    285 
    286 /* The actual interpreter loop */
    287 void interp(state_t *st) {
    288     while (1) {
    289         obj_t *x, *y, *z;
    290         char *p, c;
    291         int i;
    292         unsigned long u;
    293         /* fprintf(stderr, "Executing '%c'\n", *st->pc); */
    294         switch (c = *st->pc++) {
    295         case '\0':
    296             return;
    297         case '\r':
    298         case '\n':
    299         case '\t':
    300         case ' ': /* nop */
    301             break;
    302         case '!': /* call */
    303             POP(x);
    304             if (x->type != function) {
    305                 error("Not a function.\n");
    306             } else {
    307                 CALL(x);
    308                 decref(x);
    309             }
    310             break;
    311         case '"': /* output string */
    312             p = skip_string(st->pc);
    313             c = *p; /* Save old character */
    314             *p = '\0'; /* Change it to NUL */
    315             fputs(st->pc, stdout); /* Print the string */
    316             *p = c; /* Replace original character */
    317             st->pc = p + 1; /* Set the PC to one past the closing quote*/
    318             break;
    319         case '#': /* over */
    320             POP(y); POP(x);
    321             PUS(x); PUS(y); PUSH(x);
    322             break;
    323         case '$': /* dup */
    324             POP(x);
    325             PUS(x); PUSH(x);
    326             break;
    327         case '%': /* mod */
    328             BINOP(mpz_mod);
    329             break;
    330         case '&': /* && */
    331             BINBOOL(NONZERO(x) && NONZERO(y));
    332             break;
    333         case '\'': /* Set multi */
    334             for (p = st->pc; *p && *p != '\''; p++);
    335             st->pc = p + 1;
    336             for (p--; *p != '\''; p--) {
    337                 if (*p >= 'a' && *p <= 'z') {
    338                     /* local */
    339                     POP(x);
    340                     i = *p - 'a';
    341                     if ((y = st->frame->vars[i]) != NULL) decref(y);
    342                     st->frame->vars[i] = x;
    343                 } else if (*p >= 'A' && *p <= 'Z') {
    344                     /* global */
    345                     POP(x);
    346                     i = *p - 'A';
    347                     if ((y = st->vars[i]) != NULL) decref(y);
    348                     st->vars[i] = x;
    349                 } else if (*p != '\n' && *p != '\t' && *p != ' ') {
    350                     error("Not a variable: '%c'", *p);
    351                 }
    352             }
    353             break;
    354         case '(': /* Comment; can't be nested */
    355             st->pc = skip_comment(st->pc);
    356             break;
    357         case '*': /* mul */
    358             BINOP(mpz_mul);
    359             break;
    360         case '+': /* add */
    361             BINOP(mpz_add);
    362             break;
    363         case ',': /* print character */
    364             POP(x);
    365             u = to_ulong(x);
    366             putchar(u);
    367             decref(x);
    368             break;
    369         case '-': /* sub */
    370             BINOP(mpz_sub);
    371             break;
    372         case '.': /* print */
    373             POP(x);
    374             print_obj(stdout, x);
    375             decref(x);
    376             break;
    377         case '/': /* div */
    378             BINOP(mpz_fdiv_q);
    379             break;
    380         case '0':
    381         case '1':
    382         case '2':
    383         case '3':
    384         case '4':
    385         case '5':
    386         case '6':
    387         case '7':
    388         case '8':
    389         case '9':
    390             p = st->pc;
    391             /* Skip to the first non-digit */
    392             while ((c = *p) >= '0' && c <= '9') p++;
    393             *p = '\0'; /* Temporarily put a NUL there */
    394             PUS(num_new_from_str(st->pc-1));
    395             *p = c; /* Replace original character */
    396             st->pc = p;
    397             break;
    398         case ':': /* Set variable */
    399             POP(x);
    400             c = *st->pc++;
    401             if (c >= 'A' && c <= 'Z') {
    402                 /* global */
    403                 i = c - 'A';
    404                 if ((y = st->vars[i]) != NULL) decref(y);
    405                 st->vars[i] = x;
    406             } else if (c >= 'a' && c <= 'z') {
    407                 /* local */
    408                 i = c - 'a';
    409                 if ((y = st->frame->vars[i]) != NULL) decref(y);
    410                 st->frame->vars[i] = x;
    411             } else {
    412                 error("Not a variable: '%c'\n", *st->pc);
    413             }
    414             break;
    415         /* case ';': */
    416         /*     break; */
    417         case '<': /* less than */
    418             BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) < 0);
    419             break;
    420         case '=': /* equal to */
    421             BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) == 0);
    422             break;
    423         case '>': /* greater than */
    424             BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) > 0);
    425             break;
    426         case '?': /* if */
    427             POP(z); POP(y); POP(x);
    428             if (x->type != number || y->type != function || z->type != function)
    429                 error("Wrong argument type.");
    430             CALL(NONZERO(x) ? y : z);
    431             decref(z); decref(y); decref(x);
    432             break;
    433         case '@': /* rot */
    434             POP(z); POP(y); POP(x);
    435             PUS(y); PUS(z); PUS(x);
    436             break;
    437             /* global variables */
    438         case 'A':
    439         case 'B':
    440         case 'C':
    441         case 'D':
    442         case 'E':
    443         case 'F':
    444         case 'G':
    445         case 'H':
    446         case 'I':
    447         case 'J':
    448         case 'K':
    449         case 'L':
    450         case 'M':
    451         case 'N':
    452         case 'O':
    453         case 'P':
    454         case 'Q':
    455         case 'R':
    456         case 'S':
    457         case 'T':
    458         case 'U':
    459         case 'V':
    460         case 'W':
    461         case 'X':
    462         case 'Y':
    463         case 'Z':
    464             /* global variables */
    465             i = c - 'A';
    466             if ((x = st->vars[i]) == NULL) {
    467                 error("Uninitialized variable '%c'\n", c);
    468             }
    469             if (x->type == function) {
    470                 CALL(x);
    471             } else {
    472                 PUSH(x);
    473             }
    474             break;
    475         case '[':
    476             PUS(fun_new(st->pc));
    477             i = 1;
    478             while (*st->pc) {
    479                 switch (*st->pc++) {
    480                 case '"':
    481                     st->pc = skip_string(st->pc) + 1;
    482                     break;
    483                 case '(':
    484                     st->pc = skip_comment(st->pc) + 1;
    485                     break;
    486                 case '[':
    487                     i++;
    488                     break;
    489                 case ']':
    490                     if (--i <= 0) goto done;
    491                     break;
    492                 }
    493             }
    494         done:
    495             break;
    496         case '\\': /* swap */
    497             POP(y); POP(x);
    498             PUS(y); PUS(x);
    499             break;
    500         case ']':
    501             POPRET();
    502             break;
    503         case '^': /* trace */
    504             print_trace(st);
    505             break;
    506         /* case '^': /\* pow *\/ */
    507         /*     POP(y); POP(x); */
    508         /*     z = num_new(); */
    509         /*     mpz_pow_ui(z->data.mpz, *to_mpz(x), to_ulong(y)); */
    510         /*     PUSH(z); */
    511         /*     decref(y); decref(x); */
    512         /*     break; *\/ */
    513         case '_': /* neg */
    514             POP(x);
    515             mpz_neg(*to_mpz(x), x->data.mpz);
    516             PUS(x);
    517             break;
    518         case '`': /* drop */
    519             POP(x);
    520             decref(x);
    521             break;
    522         case 'a':
    523         case 'b':
    524         case 'c':
    525         case 'd':
    526         case 'e':
    527         case 'f':
    528         case 'g':
    529         case 'h':
    530         case 'i':
    531         case 'j':
    532         case 'k':
    533         case 'l':
    534         case 'm':
    535         case 'n':
    536         case 'o':
    537         case 'p':
    538         case 'q':
    539         case 'r':
    540         case 's':
    541         case 't':
    542         case 'u':
    543         case 'v':
    544         case 'w':
    545         case 'x':
    546         case 'y':
    547         case 'z':
    548             /* local variables */
    549             i = c - 'a';
    550             if ((x = st->frame->vars[i]) == NULL) {
    551                 error("Uninitialized variable '%c'\n", c);
    552             }
    553             if (x->type == function) {
    554                 CALL(x);
    555             } else {
    556                 PUSH(x);
    557             }
    558             break;
    559         /* case '{': */
    560         /*     break; */
    561         case '|': /* or */
    562             BINBOOL(NONZERO(x) || NONZERO(y));
    563             break;
    564         /* case '}': */
    565         /*     break; */
    566         case '~': /* not */
    567             POP(x);
    568             PUSH(ZERO(x) ? one : zero);
    569             decref(x);
    570             break;
    571         default:
    572             error("Undefined token '%c'\n", c);
    573         }
    574     }
    575 }
    576 
    577 
    578 state_t *new_state() {
    579     state_t *st = calloc(sizeof(state_t) + sizeof(obj_t) * STACK_SIZE, 1);
    580     st->tos = st->stack;
    581     st->stack_limit = &st->stack[STACK_SIZE];
    582     st->call_stack = calloc(sizeof(*st->call_stack), CALL_STACK_SIZE);
    583     st->call_stack_limit = &st->call_stack[CALL_STACK_SIZE];
    584     st->frame = st->call_stack;
    585     return st;
    586 }
    587 
    588 
    589 int main(int argc, char *argv[]) {
    590     assert(argc == 2);
    591     init();
    592     state_t *st = new_state();
    593     st->pc = argv[1];
    594     interp(st);
    595     return 0;
    596 }