itty

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

commit e226c91f7692f161bfb33cfb468d4d03f49d0f7f
Author: Sean Lynch <seanl@literati.org>
Date:   Thu, 26 Aug 2010 11:32:13 -0700

Initial commit

Diffstat:
A.gitignore | 1+
Ahello.itty | 1+
Aitty.c | 596+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aitty.make | 8++++++++
Api.itty | 1+
5 files changed, 607 insertions(+), 0 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -0,0 +1 @@ +/itty diff --git a/hello.itty b/hello.itty @@ -0,0 +1 @@ +"Hello world!"10, diff --git a/itty.c b/itty.c @@ -0,0 +1,596 @@ +#include <assert.h> +#include <stdarg.h> +#include <stdint.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <sysexits.h> + +#include <gmp.h> + +#define STACK_SIZE 500 +#define CALL_STACK_SIZE 500 + +enum type_e { number, function }; + +/* PUSH with no incref */ +#define PUS(x) do { \ + if (st->tos >= st->stack_limit) \ + error("Stack overflow.\n"); \ + *st->tos++ = (x); \ + } while (0) + + +/* PUSH with incref */ +#define PUSH(x) do { \ + incref(x); \ + PUS(x); \ + } while (0) + + +#define POP(x) do { \ + if (st->tos <= st->stack) \ + error("Stack underflow.\n"); \ + x = *--st->tos; \ + } while (0) + + +/* Deal with the return stack */ +#define POPRET() do { \ + if (st->frame <= st->call_stack) \ + error("Call stack underflow.\n"); \ + struct frame_st *frame = st->frame--; \ + st->pc = frame->ret; \ + clear_vars(frame); \ + } while (0) + + +#define PUSHRET() do { \ + if (st->frame >= st->call_stack_limit) \ + error("Call stack overflow.\n"); \ + struct frame_st *frame = ++st->frame; \ + frame->ret = st->pc; \ + } while (0) + + +/* Call the function in x. */ +#define CALL(x) do { \ + if (*st->pc != ']') { \ + PUSHRET(); \ + } else { \ + struct frame_st *frame = st->frame; \ + clear_vars(frame); \ + } \ + st->pc = (x)->data.fun; \ + } while (0) + + +#define ZERO(x) (mpz_cmp_ui(*to_mpz(x), 0) == 0) +#define NONZERO(x) (!ZERO(x)) + + +/* Binary boolean operations on bignums */ +#define BINBOOL(op) do { \ + POP(y); \ + POP(x); \ + PUSH((op) ? one : zero); \ + decref(y); \ + decref(x); \ + } while (0) + + +/* Binary operation on bignums */ +#define BINOP(f) do { \ + POP(y); \ + POP(x); \ + z = num_new(); \ + f(z->data.mpz, *to_mpz(x), *to_mpz(y)); \ + decref(y); \ + decref(x); \ + PUS(z); \ + } while (0) + + +typedef struct { + int refcnt; + enum type_e type; + union { + mpz_t mpz; + char *fun; + } data; +} obj_t; + + +struct frame_st { + char *ret; + obj_t *vars[26]; +}; + + +typedef struct { + char *pc; + obj_t **tos; + obj_t **stack_limit; + struct frame_st *call_stack; + struct frame_st *call_stack_limit; + struct frame_st *frame; + obj_t *vars[26]; + obj_t *stack[]; +} state_t; + + +static obj_t *zero; +static obj_t *one; + + +void error(char *format, ...) { + va_list argp; + va_start(argp, format); + vfprintf(stderr, format, argp); + exit(EX_DATAERR); +} + + +void obj_free(obj_t *o) { + if (o->type == number) mpz_clear(o->data.mpz); + free(o); +} + + +void decref(obj_t *o) { + assert(o->refcnt > 0); + if (--o->refcnt == 0) obj_free(o); +} + + +void incref(obj_t *o) { + assert(o->refcnt > 0); + ++o->refcnt; +} + + +void clear_vars(struct frame_st *frame) { + int i; + for (i = 0; i < 26; ++i) { + if (frame->vars[i] != NULL) { + decref(frame->vars[i]); + frame->vars[i] = NULL; + } + } +} + + +mpz_t *to_mpz(obj_t *o) { + if (o->type != number) error("Argument is not a number.\n"); + return &o->data.mpz; +} + + +unsigned long to_ulong(obj_t *o) { + mpz_t *x = to_mpz(o); + unsigned int r = 0; + if (mpz_fits_ulong_p(*x)) { + r = mpz_get_ui(*x); + } else { + error("Argument too big.\n"); + } + return r; +} + + +obj_t *obj_new(enum type_e t) { + obj_t *o = malloc(sizeof(*o)); + o->refcnt = 1; + o->type = t; + return o; +} + + +obj_t *fun_new(char *f) { + obj_t *o = obj_new(function); + o->data.fun = f; + return o; +} + + +obj_t *num_new() { + obj_t *o = obj_new(number); + mpz_init(o->data.mpz); + return o; +} + + +obj_t *num_new_from_str(char *str) { + obj_t *o = obj_new(number); + mpz_init_set_str(o->data.mpz, str, 10); + return o; +} + +/* Utility functions */ +void init() { + zero = num_new_from_str("0"); + one = num_new_from_str("1"); +} + +/* Debugging */ +void print_obj(FILE *fp, obj_t *x) { + switch (x->type) { + case number: + gmp_fprintf(fp, "%Zd", x->data.mpz); + break; + case function: + fprintf(fp, "<fun %p>", x->data.fun); + break; + default: + error("Unrecognized type %d\n", x->type); + } + fflush(stdout); +} + + +void print_stack(state_t *st) { + obj_t **p; + for (p = st->tos-1; p >= st->stack; p--) { + fprintf(stderr, " %3ld: ", st->tos-p-1); + print_obj(stderr, *p); + } +} + + +void print_vars(obj_t *vars[], int global) { + char startc = global ? 'A' : 'a'; + int i; + for (i = 0; i < 26; i++) { + if (vars[i] != NULL && vars[i]->type == number) { + fprintf(stderr, " %c = ", startc + i); + print_obj(stderr, vars[i]); + } + } +} + + +void print_trace(state_t *st) { + fprintf(stderr, "DEBUG:\nStack:\n"); + print_stack(st); + fprintf(stderr, "Global vars:\n"); + print_vars(st->vars, 1); + fprintf(stderr, "Local vars:\n"); + print_vars(st->frame->vars, 0); + fprintf(stderr, "\n"); +} + + +/* + * Interpretation utility functions + */ + +/* Skips the closing paren */ +char *skip_comment(char *p) { + while (*p && *p++ != ')'); + return p; +} + + +/* Leaves you on closing quote */ +char *skip_string(char *p) { + while (*p && *p != '"') { + if (*p == '\\') p++; /* Escape */ + p++; + } + return p; +} + + + + +/* The actual interpreter loop */ +void interp(state_t *st) { + while (1) { + obj_t *x, *y, *z; + char *p, c; + int i; + unsigned long u; + /* fprintf(stderr, "Executing '%c'\n", *st->pc); */ + switch (c = *st->pc++) { + case '\0': + return; + case '\r': + case '\n': + case '\t': + case ' ': /* nop */ + break; + case '!': /* call */ + POP(x); + if (x->type != function) { + error("Not a function.\n"); + } else { + CALL(x); + decref(x); + } + break; + case '"': /* output string */ + p = skip_string(st->pc); + c = *p; /* Save old character */ + *p = '\0'; /* Change it to NUL */ + fputs(st->pc, stdout); /* Print the string */ + *p = c; /* Replace original character */ + st->pc = p + 1; /* Set the PC to one past the closing quote*/ + break; + case '#': /* over */ + POP(y); POP(x); + PUS(x); PUS(y); PUSH(x); + break; + case '$': /* dup */ + POP(x); + PUS(x); PUSH(x); + break; + case '%': /* mod */ + BINOP(mpz_mod); + break; + case '&': /* && */ + BINBOOL(NONZERO(x) && NONZERO(y)); + break; + case '\'': /* Set multi */ + for (p = st->pc; *p && *p != '\''; p++); + st->pc = p + 1; + for (p--; *p != '\''; p--) { + if (*p >= 'a' && *p <= 'z') { + /* local */ + POP(x); + i = *p - 'a'; + if ((y = st->frame->vars[i]) != NULL) decref(y); + st->frame->vars[i] = x; + } else if (*p >= 'A' && *p <= 'Z') { + /* global */ + POP(x); + i = *p - 'A'; + if ((y = st->vars[i]) != NULL) decref(y); + st->vars[i] = x; + } else if (*p != '\n' && *p != '\t' && *p != ' ') { + error("Not a variable: '%c'", *p); + } + } + break; + case '(': /* Comment; can't be nested */ + st->pc = skip_comment(st->pc); + break; + case '*': /* mul */ + BINOP(mpz_mul); + break; + case '+': /* add */ + BINOP(mpz_add); + break; + case ',': /* print character */ + POP(x); + u = to_ulong(x); + putchar(u); + decref(x); + break; + case '-': /* sub */ + BINOP(mpz_sub); + break; + case '.': /* print */ + POP(x); + print_obj(stdout, x); + decref(x); + break; + case '/': /* div */ + BINOP(mpz_fdiv_q); + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + p = st->pc; + /* Skip to the first non-digit */ + while ((c = *p) >= '0' && c <= '9') p++; + *p = '\0'; /* Temporarily put a NUL there */ + PUS(num_new_from_str(st->pc-1)); + *p = c; /* Replace original character */ + st->pc = p; + break; + case ':': /* Set variable */ + POP(x); + c = *st->pc++; + if (c >= 'A' && c <= 'Z') { + /* global */ + i = c - 'A'; + if ((y = st->vars[i]) != NULL) decref(y); + st->vars[i] = x; + } else if (c >= 'a' && c <= 'z') { + /* local */ + i = c - 'a'; + if ((y = st->frame->vars[i]) != NULL) decref(y); + st->frame->vars[i] = x; + } else { + error("Not a variable: '%c'\n", *st->pc); + } + break; + /* case ';': */ + /* break; */ + case '<': /* less than */ + BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) < 0); + break; + case '=': /* equal to */ + BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) == 0); + break; + case '>': /* greater than */ + BINBOOL(mpz_cmp(*to_mpz(x), *to_mpz(y)) > 0); + break; + case '?': /* if */ + POP(z); POP(y); POP(x); + if (x->type != number || y->type != function || z->type != function) + error("Wrong argument type."); + CALL(NONZERO(x) ? y : z); + decref(z); decref(y); decref(x); + break; + case '@': /* rot */ + POP(z); POP(y); POP(x); + PUS(y); PUS(z); PUS(x); + break; + /* global variables */ + case 'A': + case 'B': + case 'C': + case 'D': + case 'E': + case 'F': + case 'G': + case 'H': + case 'I': + case 'J': + case 'K': + case 'L': + case 'M': + case 'N': + case 'O': + case 'P': + case 'Q': + case 'R': + case 'S': + case 'T': + case 'U': + case 'V': + case 'W': + case 'X': + case 'Y': + case 'Z': + /* global variables */ + i = c - 'A'; + if ((x = st->vars[i]) == NULL) { + error("Uninitialized variable '%c'\n", c); + } + if (x->type == function) { + CALL(x); + } else { + PUSH(x); + } + break; + case '[': + PUS(fun_new(st->pc)); + i = 1; + while (*st->pc) { + switch (*st->pc++) { + case '"': + st->pc = skip_string(st->pc) + 1; + break; + case '(': + st->pc = skip_comment(st->pc) + 1; + break; + case '[': + i++; + break; + case ']': + if (--i <= 0) goto done; + break; + } + } + done: + break; + case '\\': /* swap */ + POP(y); POP(x); + PUS(y); PUS(x); + break; + case ']': + POPRET(); + break; + case '^': /* trace */ + print_trace(st); + break; + /* case '^': /\* pow *\/ */ + /* POP(y); POP(x); */ + /* z = num_new(); */ + /* mpz_pow_ui(z->data.mpz, *to_mpz(x), to_ulong(y)); */ + /* PUSH(z); */ + /* decref(y); decref(x); */ + /* break; *\/ */ + case '_': /* neg */ + POP(x); + mpz_neg(*to_mpz(x), x->data.mpz); + PUS(x); + break; + case '`': /* drop */ + POP(x); + decref(x); + break; + case 'a': + case 'b': + case 'c': + case 'd': + case 'e': + case 'f': + case 'g': + case 'h': + case 'i': + case 'j': + case 'k': + case 'l': + case 'm': + case 'n': + case 'o': + case 'p': + case 'q': + case 'r': + case 's': + case 't': + case 'u': + case 'v': + case 'w': + case 'x': + case 'y': + case 'z': + /* local variables */ + i = c - 'a'; + if ((x = st->frame->vars[i]) == NULL) { + error("Uninitialized variable '%c'\n", c); + } + if (x->type == function) { + CALL(x); + } else { + PUSH(x); + } + break; + /* case '{': */ + /* break; */ + case '|': /* or */ + BINBOOL(NONZERO(x) || NONZERO(y)); + break; + /* case '}': */ + /* break; */ + case '~': /* not */ + POP(x); + PUSH(ZERO(x) ? one : zero); + decref(x); + break; + default: + error("Undefined token '%c'\n", c); + } + } +} + + +state_t *new_state() { + state_t *st = calloc(sizeof(state_t) + sizeof(obj_t) * STACK_SIZE, 1); + st->tos = st->stack; + st->stack_limit = &st->stack[STACK_SIZE]; + st->call_stack = calloc(sizeof(*st->call_stack), CALL_STACK_SIZE); + st->call_stack_limit = &st->call_stack[CALL_STACK_SIZE]; + st->frame = st->call_stack; + return st; +} + + +int main(int argc, char *argv[]) { + assert(argc == 2); + init(); + state_t *st = new_state(); + st->pc = argv[1]; + interp(st); + return 0; +} diff --git a/itty.make b/itty.make @@ -0,0 +1,7 @@ +# -*- makefile -*- + +CC=gcc +CFLAGS=-I/usr/local/homebrew/include -L/usr/local/homebrew/lib -lgmp -Os -Wall -pedantic -std=c99 + +itty: itty.c + $(CC) $(CFLAGS) -o itty itty.c+ \ No newline at end of file diff --git a/pi.itty b/pi.itty @@ -0,0 +1 @@ +1:K[KK4*2+0K2*1+K1+:K]:G['abcdefgh'ae*af*bh*+ce*dg*+cf*dh*+]:O['qrstj'qj*r+sj*t+/]:E1:W0:X0:Y1:Z[WXYZ3E:Q[WXYZ4EQ=~[WXYZGO'WXYZ'WXYZ3E:QL][]?]$:L!Q.10 10_Q*0 1WXYZO'WXYZ'M]$:M!