From 32c02216ce3df45004a933cc16745880841262e5 Mon Sep 17 00:00:00 2001
From: Aleksey Veresov <aleksey@veresov.pro>
Date: Sat, 27 Mar 2021 00:10:49 +0300
Subject: Attempt to make types more generic.

Thing doesn't work now.
---
 src/csx.c     | 889 +++++++++++++++++++++++++++++-----------------------------
 src/csxbind.c | 143 ++++++++++
 2 files changed, 583 insertions(+), 449 deletions(-)
 create mode 100644 src/csxbind.c

(limited to 'src')

diff --git a/src/csx.c b/src/csx.c
index 440d732..caf6288 100644
--- a/src/csx.c
+++ b/src/csx.c
@@ -6,139 +6,104 @@
 #include <stdio.h>
 
 
-static void init();
-
-
-typedef enum csx_type {
-    type_null,
-    type_pair,
-    type_name,
-    type_base,
-    type_int,
-    type_real,
-    type_fn,
-    type_sx,
-    type_str
-} csx_type;
-
-static void setmark(void *p)   { ((int *)p)[-2] = 1; }
-static int mark(void *p)       { return ((int *)p)[-2]; }
-static csx_type type(void *p)  { return ((int *)p)[-1]; }
-
-static void **objs = 0;
-static int objslen = 0;
-static int objssize;
-
-static void pushobj(void *p)
-{
-    if (!objs) {
-        objs = malloc(sizeof(void *));
-        objslen = 0;
-        objssize = 1;
-    }
-    if (objslen == objssize) {
-        objs = realloc(objs, (objssize *= 2) * sizeof(void *));
-    }
-    objs[objslen++] = p;
-}
+typedef struct fn_data {
+    csxpair *params;
+    csxpair *body;
+    csxpair *context;
+} fn_data;
+
 
-static void **stack = 0;
-static int stacklen = 0;
-static int stacksize;
+csxobj *csx_obj(void *p)  { return (csxobj *)((int *)p - 2); }
 
-static void push(void *p)
+
+static void pushobj(csxi *csx, void *p)
 {
-    if (!stack) {
-        stack = malloc(sizeof(void *));
-        stacklen = 0;
-        stacksize = 1;
+    if (!csx->objs) {
+        csx->objs = malloc(sizeof(void *));
+        csx->objslen = 0;
+        csx->objssize = 1;
     }
-    if (stacklen == stacksize) {
-        stack = realloc(stack, (stacksize *= 2) * sizeof(void *));
+    if (csx->objslen == csx->objssize) {
+        csx->objssize *= 2;
+        csx->objs = realloc(csx->objs, csx->objssize * sizeof(void *));
     }
-    stack[stacklen++] = p;
+    csx->objs[csx->objslen++] = p;
 }
 
-static void *pop()
+static void push(csxi *csx, void *p)
 {
-    return stack[--stacklen];
+    if (!csx->stack) {
+        csx->stack = malloc(sizeof(void *));
+        csx->stacklen = 0;
+        csx->stacksize = 1;
+    }
+    if (csx->stacklen == csx->stacksize) {
+        csx->stacksize *= 2;
+        csx->stack = realloc(csx->stack, csx->stacksize * sizeof(void *));
+    }
+    csx->stack[csx->stacklen++] = p;
 }
 
-static void restore(int len)
+static void *pop(csxi *csx)  { return csx->stack[--(csx->stacklen)]; }
+
+static void restore(csxi *csx, int len)
 {
-    stacklen = len;
-    if (stacklen <= stacksize / 4) {
-        stacksize /= 2;
-        stack = realloc(stack, stacksize * sizeof(void *));
+    csx->stacklen = len;
+    if (csx->stacklen <= csx->stacksize / 4) {
+        csx->stacksize /= 2;
+        csx->stack = realloc(csx->stack, csx->stacksize * sizeof(void *));
     }
 }
 
-static void *new(csx_type type, int data_size)
+static void *new(csxi *csx, void *type, int data_size)
 {
-    int *res = malloc(sizeof(int) * 2 + data_size);
+    csxobj *res = malloc(sizeof(*res) - 1 + data_size);
     if (!res) exit(1);
-    res[0] = 0;
-    res[1] = type;
-    pushobj(res);
-    return res + 2;
+    res->mark = 0;
+    res->type = type;
+    pushobj(csx, res);
+    return res->data;
 }
 
 
-typedef struct pair_data {
-    void *head;
-    void *tail;
-} pair_data;
+static void *head(csxpair *pair)  { return pair->head; }
+static void *tail(csxpair *pair)  { return pair->tail; }
 
-static void *head(pair_data *pair)  { return pair->head; }
-static void *tail(pair_data *pair)  { return pair->tail; }
-
-static pair_data *new_pair(void *head, void *tail)
+csxpair *csx_pair(csxi *csx, void *head, void *tail)
 {
-    pair_data *res = new(type_pair, sizeof(pair_data));
+    csxpair *res = new(csx, csx->basenames.pair, sizeof(*res));
     res->head = head;
     res->tail = tail;
     return res;
 }
 
 
-typedef struct fn_data {
-    pair_data *params;
-    pair_data *body;
-    pair_data *context;
-} fn_data;
-
-
-static int initiated = 0;
-static void *null;
-static void *one;
-static pair_data *context;
-
-
-static void deepmark(void *p)
+static void deepmark(csxi *csx, void *p)
 {
-    if (mark(p)) return;
-    setmark(p);
-    if (type(p) == type_pair) {
-        deepmark(head(p));
-        deepmark(tail(p));
-    } else if (type(p) == type_fn || type(p) == type_sx) {
+    if (csx_obj(p)->mark) return;
+    csx_obj(p)->mark = 1;
+    if (csx_obj(p)->type == csx->basenames.pair) {
+        deepmark(csx, head(p));
+        deepmark(csx, tail(p));
+    } else if (csx_obj(p)->type == csx->basenames.fn ||
+               csx_obj(p)->type == csx->basenames.sx) {
         fn_data *fn = p;
-        deepmark(fn->params);
-        deepmark(fn->body);
-        deepmark(fn->context);
+        deepmark(csx, fn->params);
+        deepmark(csx, fn->body);
+        deepmark(csx, fn->context);
     }
 }
 
-static void sweep()
+static void sweep(csxi *csx)
 {
-    void **old = objs;
-    int len = objslen;
+    void **old = csx->objs;
+    int len = csx->objslen;
     int i;
-    objs = 0;
+    csx->objs = 0;
     for (i = 0; i != len; ++i) {
         if (*(int *)(old[i])) {
             *(int *)(old[i]) = 0;
-            pushobj(old[i]);
+            pushobj(csx, old[i]);
         } else {
             free(old[i]);
         }
@@ -146,607 +111,633 @@ static void sweep()
     free(old);
 }
 
-static void gc()
+static void gc(csxi *csx)
 {
     int i;
-    static int lastlen = 0;
-    if (objslen < lastlen * 2) return;
-    setmark(null);
-    setmark(one);
-    deepmark(context);
-    for (i = 0; i != stacklen; ++i) {
-        deepmark(stack[i]);
+    if (csx->objslen < csx->lastlen * 2) return;
+    csx_obj(csx->basenames.name)->mark = 1;
+    csx_obj(csx->basenames.pair)->mark = 1;
+    deepmark(csx, csx->context);
+    for (i = 0; i != csx->stacklen; ++i) {
+        deepmark(csx, csx->stack[i]);
     }
-    sweep();
-    lastlen = objslen;
+    sweep(csx);
+    csx->lastlen = csx->objslen;
 }
 
 
-char *csx_name(const char *name)
+char *csx_name(csxi *csx, const char *name)
 {
-    if (!initiated) init();
-    int namesize = strlen(name) + 1;
+    const int namesize = strlen(name) + 1;
     int i;
-    for (i = 0; i != objslen; ++i) {
-        void *obj = (int *)(objs[i]) + 2;
-        if (type(obj) != type_name) continue;
+    for (i = 0; i != csx->objslen; ++i) {
+        void *obj = (int *)(csx->objs[i]) + 2;
+        if (csx_obj(obj)->type != csx->basenames.name) continue;
         if (!strncmp(obj, name, namesize)) return obj;
     }
-    void *res = new(type_name, namesize);
+    void *res = new(csx, csx->basenames.name, namesize);
     memcpy(res, name, namesize);
     return res;
 }
 
-csx_base_data *csx_base(csx_base_data base)
+csxbase *csx_base(csxi *csx, csxbase base)
 {
-    if (!initiated) init();
-    csx_base_data *res = new(type_base, sizeof(csx_base_data));
+    csxbase *res = new(csx, csx->basenames.base, sizeof(*res));
     *res = base;
     return res;
 }
 
-int *csx_int(int num)
-{
-    if (!initiated) init();
-    int *res = new(type_int, sizeof(int));
-    *res = num;
-    return res;
-}
-
-double *csx_real(double num)
+int *csx_int(csxi *csx, int num)
 {
-    if (!initiated) init();
-    double *res = new(type_real, sizeof(double));
+    int *res = new(csx, csx->basenames._int, sizeof(*res));
     *res = num;
     return res;
 }
 
 
-static void *run_each(void *l)
+static void *run_each(csxi *i, void *l)
 {
-    if (type(l) != type_pair) return null;
-    push(l);
-    int ret = stacklen;
-    pair_data *res = new_pair(csx_run(head(l)), null);
-    pair_data **p = (pair_data **)&res->tail;
+    if (csx_obj(l)->type != i->basenames.pair) return i->null;
+    push(i, l);
+    int ret = i->stacklen;
+    csxpair *res = csx_pair(i, csx_run(i, head(l)), i->null);
+    csxpair **p = (csxpair **)&res->tail;
     l = tail(l);
-    while (type(l) == type_pair) {
-        push(res);
-        int resret = stacklen;
-        *p = new_pair(csx_run(head(l)), null);
-        p = (pair_data **)&(*p)->tail;
-        restore(resret);
-        pop();
+    while (csx_obj(l)->type == i->basenames.pair) {
+        push(i, res);
+        int resret = i->stacklen;
+        *p = csx_pair(i, csx_run(i, head(l)), i->null);
+        p = (csxpair **)&(*p)->tail;
+        restore(i, resret);
+        pop(i);
         l = tail(l);
     }
-    restore(ret);
-    pop();
+    restore(i, ret);
+    pop(i);
     return res;
 }
 
 
-static void *lookup_frame(const char *name)
+static void *lookup_frame(csxi *i, const char *name)
 {
-    pair_data *frame = context->head;
-    while (type(frame) == type_pair) {
+    csxpair *frame = i->context->head;
+    while (csx_obj(frame)->type == i->basenames.pair) {
         if (head(frame->head) == name) return frame->head;
         frame = frame->tail;
     }
-    return null;
+    return i->null;
 }
 
-static void *lookup(const char *name)
+static void *lookup(csxi *i, const char *name)
 {
-    void *saved = context;
-    while (type(context) == type_pair) {
-        pair_data *res = lookup_frame(name);
-        if (type(res) != type_null) {
-            context = saved;
+    void *saved = i->context;
+    while (csx_obj(i->context)->type == i->basenames.pair) {
+        csxpair *res = lookup_frame(i, name);
+        if (res != i->null) {
+            i->context = saved;
             return res->tail;
         }
-        context = context->tail;
+        i->context = i->context->tail;
     }
-    context = saved;
-    return null;
+    i->context = saved;
+    return i->null;
 }
 
-static void *base_set(void *arg)
+static void *base_set(csxi *i, void *arg)
 {
-    pair_data *res;
-    push(arg);
-    int ret = stacklen;
+    csxpair *res;
+    push(i, arg);
+    int ret = i->stacklen;
     void *name = head(arg);
-    void *value = csx_run(head(tail(arg)));
-    if (type(context) == type_null) {
-        void *nameval = new_pair(name, value);
-        context = new_pair(new_pair(nameval, null), null);
-        restore(ret);
-        pop();
-        return null;
+    void *value = csx_run(i, head(tail(arg)));
+    if (i->context == i->null) {
+        void *nameval = csx_pair(i, name, value);
+        i->context = csx_pair(i, csx_pair(i, nameval, i->null), i->null);
+        restore(i, ret);
+        pop(i);
+        return i->null;
     }
-    res = lookup_frame(name);
-    if (type(res) != type_null) {
+    res = lookup_frame(i, name);
+    if (res != i->null) {
         res->tail = value;
     } else {
-        void **names = &context->head;
-        *names = new_pair(new_pair(name, value), *names);
+        void **names = &i->context->head;
+        *names = csx_pair(i, csx_pair(i, name, value), *names);
     }
-    restore(ret);
-    pop();
-    return null;
+    restore(i, ret);
+    pop(i);
+    return i->null;
 }
 
-static void *base_is_set(void *arg)
+static void *base_is_set(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    return lookup(head(arg)) ? one : null;
+    arg = run_each(i, arg);
+    return lookup(i, head(arg)) ? i->one : i->null;
 }
 
-static void *base_sethead(void *arg)
+static void *base_sethead(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    pair_data *p = head(arg);
+    arg = run_each(i, arg);
+    csxpair *p = head(arg);
     p->head = head(tail(arg));
-    return null;
+    return i->null;
 }
 
-static void *base_settail(void *arg)
+static void *base_settail(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    pair_data *p = head(arg);
+    arg = run_each(i, arg);
+    csxpair *p = head(arg);
     p->tail = head(tail(arg));
-    return null;
+    return i->null;
 }
 
-static void *base_pair(void *arg)
+static void *base_pair(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    return new_pair(head(arg), head(tail(arg)));
+    arg = run_each(i, arg);
+    return csx_pair(i, head(arg), head(tail(arg)));
 }
 
-static void *base_head(void *arg)
+static void *base_head(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     return head(head(arg));
 }
 
-static void *base_tail(void *arg)
+static void *base_tail(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     return tail(head(arg));
 }
 
-static void *base_quote(void *arg)
+static void *base_qt(csxi *i, void *arg)
 {
     return head(arg);
 }
 
-static void *base_same(void *arg)
+static void *base_same(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(head(arg)) == type_int)
-        return *(int *)head(arg) == *(int *)head(tail(arg)) ? one : null;
-    if (type(head(arg)) == type_real)
-        return *(double *)head(arg) == *(double *)head(tail(arg)) ? one : null;
-    return head(arg) == head(tail(arg)) ? one : null;
+    arg = run_each(i, arg);
+    if (csx_obj(head(arg))->type == i->basenames._int)
+        return *(int *)head(arg) == *(int *)head(tail(arg)) ? i->one : i->null;
+    return head(arg) == head(tail(arg)) ? i->one : i->null;
 }
 
-static void *base_type(void *arg)
+static void *base_type(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    switch (type(head(arg))) {
-    case type_null: return null;
-    case type_pair: return csx_name("pair");
-    case type_name: return csx_name("name");
-    case type_base: return csx_name("base");
-    case type_int:  return csx_name("int");
-    case type_real: return csx_name("real");
-    case type_fn:   return csx_name("fn");
-    case type_sx:   return csx_name("sx");
-    case type_str:  return csx_name("str");
-    }
-    return 0;
+    arg = run_each(i, arg);
+    return csx_obj(head(arg))->type;
 }
 
-static void *base_do(void *arg)
+static void *base_do(csxi *i, void *arg)
 {
-    void *res = null;
-    arg = run_each(arg);
-    while (type(arg) == type_pair) {
+    void *res = i->null;
+    arg = run_each(i, arg);
+    while (csx_obj(arg)->type == i->basenames.pair) {
         res = head(arg);
         arg = tail(arg);
     }
     return res;
 }
 
-static void *base_fn(void *arg)
+static void *base_fn(csxi *i, void *arg)
 {
-    fn_data *res = new(type_fn, sizeof(fn_data));
+    fn_data *res = new(i, i->basenames.fn, sizeof(*res));
     res->params = head(arg);
     res->body = tail(arg);
-    res->context = context;
+    res->context = i->context;
     return res;
 }
 
-static void *base_sx(void *arg)
+static void *base_sx(csxi *i, void *arg)
 {
-    fn_data *res = new(type_sx, sizeof(fn_data));
+    fn_data *res = new(i, i->basenames.sx, sizeof(*res));
     res->params = head(arg);
     res->body = tail(arg);
-    res->context = context;
+    res->context = i->context;
     return res;
 }
 
-static void *base_if(void *arg)
+static void *base_if(csxi *i, void *arg)
 {
-    if (type(arg) != type_pair) return null;
-    if (type(tail(arg)) != type_pair) return csx_run(head(arg));
-    return type(csx_run(head(arg))) != type_null ?
-        csx_run(head(tail(arg))) :
-        base_if(tail(tail(arg)));
+    if (csx_obj(arg)->type != i->basenames.pair) return i->null;
+    if (tail(arg) == i->null) return csx_run(i, head(arg));
+    return csx_run(i, head(arg)) != i->null ?
+        csx_run(i, head(tail(arg))) :
+        base_if(i, tail(tail(arg)));
 }
 
 
-static void *base_sum(void *arg)
+static void *base_sum(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     int res = 0;
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         int *num = head(arg);
-        if (type(num) != type_int) exit(1);
+        if (csx_obj(num)->type != i->basenames._int) exit(1);
         res += *num;
         arg = tail(arg);
     }
-    return csx_int(res);
+    return csx_int(i, res);
 }
 
-static void *base_prod(void *arg)
+static void *base_prod(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     int res = 1;
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         int *num = head(arg);
-        if (type(num) != type_int) exit(1);
+        if (csx_obj(num)->type != i->basenames._int) exit(1);
         res *= *num;
         arg = tail(arg);
     }
-    return csx_int(res);
+    return csx_int(i, res);
 }
 
-static void *base_neg(void *arg)
+static void *base_neg(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    return csx_int(-*(int *)head(arg));
+    arg = run_each(i, arg);
+    return csx_int(i, -*(int *)head(arg));
 }
 
-static void *base_inv(void *arg)
-{  /* todo */
-    arg = run_each(arg);
-    return csx_int(0);
-}
-
-static void *base_div(void *arg)
+static void *base_div(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    return csx_int(*(int *)head(arg) / *(int *)head(tail(arg)));
+    arg = run_each(i, arg);
+    return csx_int(i, *(int *)head(arg) / *(int *)head(tail(arg)));
 }
 
-static void *base_mod(void *arg)
+static void *base_mod(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    return csx_int(*(int *)head(arg) % *(int *)head(tail(arg)));
+    arg = run_each(i, arg);
+    return csx_int(i, *(int *)head(arg) % *(int *)head(tail(arg)));
 }
 
-static void *base_inc(void *arg)
+static void *base_inc(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(arg) != type_pair || type(head(arg)) != type_int) return null;
+    arg = run_each(i, arg);
+    if (csx_obj(arg)->type != i->basenames.pair ||
+        csx_obj(head(arg))->type != i->basenames._int) return i->null;
     int num = *(int *)head(arg);
     arg = tail(arg);
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         int *another = head(arg);
-        if (type(another) != type_int || *another <= num) return null;
+        if (csx_obj(another)->type != i->basenames._int || *another <= num)
+            return i->null;
         num = *another;
         arg = tail(arg);
     }
-    return one;
+    return i->one;
 }
 
-static void *base_dec(void *arg)
+static void *base_dec(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(arg) != type_pair || type(head(arg)) != type_int) return null;
+    arg = run_each(i, arg);
+    if (csx_obj(arg)->type != i->basenames.pair ||
+        csx_obj(head(arg))->type != i->basenames._int) return i->null;
     int num = *(int *)head(arg);
     arg = tail(arg);
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         int *another = head(arg);
-        if (type(another) != type_int || *another >= num) return null;
+        if (csx_obj(another)->type != i->basenames._int || *another >= num)
+            return i->null;
         num = *another;
         arg = tail(arg);
     }
-    return one;
+    return i->one;
 }
 
 
-static void *base_out(void *arg)
+static void *base_out(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     int res = putchar(*(int *)head(arg));
-    return res != EOF ? one : null;
+    return res != EOF ? i->one : i->null;
 }
 
-static void *base_in(void *arg)
+static void *base_in(csxi *i, void *arg)
 {
-    arg = run_each(arg);
+    arg = run_each(i, arg);
     int res = getchar();
-    return res != EOF ? csx_int(res) : null;
+    return res != EOF ? csx_int(i, res) : i->null;
 }
 
-static void *base_name(void *arg)
+static void *base_name(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(head(arg)) != type_str) exit(1);
-    return csx_name(head(arg));
+    arg = run_each(i, arg);
+    if (csx_obj(head(arg))->type != i->basenames.str) exit(1);
+    return csx_name(i, head(arg));
 }
 
-static void *base_str(void *arg)
+static void *base_str(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(head(arg)) == type_name) return csx_str(head(arg));
-    if (type(head(arg)) == type_null) return csx_str("");
-    if (type(head(arg)) != type_pair) exit(1);
+    arg = run_each(i, arg);
+    void *t = csx_obj(head(arg))->type;
+    if (t == i->basenames.name) return csx_str(i, head(arg));
+    if (t == i->null) return csx_str(i, "");
+    if (t != i->basenames.pair) exit(1);
     int reslen = 0;
     char *res = malloc(1);
     arg = head(arg);
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         res[reslen] = *(char *)head(arg);
         res = realloc(res, ++reslen + 1);
         arg = tail(arg);
     }
     res[reslen] = 0;
-    return csx_str(res);
+    return csx_str(i, res);
 }
 
-static void *base_len(void *arg)
+static void *base_len(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(head(arg)) == type_str) return csx_int(strlen(head(arg)));
-    if (type(head(arg)) != type_pair) exit(1);
+    arg = run_each(i, arg);
+    void *t = csx_obj(head(arg))->type;
+    if (t == i->basenames.str) return csx_int(i, strlen(head(arg)));
+    if (t != i->basenames.pair) exit(1);
     int len = 0;
     arg = head(arg);
-    while (type(arg) == type_pair) {
+    while (csx_obj(arg)->type == i->basenames.pair) {
         arg = tail(arg);
         ++len;
     }
-    return csx_int(len);
+    return csx_int(i, len);
 }
 
-static void *base_run(void *arg)
+static void *base_run(csxi *i, void *arg)
 {
-    arg = run_each(arg);
-    if (type(tail(arg)) == type_null) return csx_run(head(arg));
-    push(context);
-    int ret = stacklen;
-    context = head(tail(arg));
-    void *res = csx_run(head(arg));
-    void *rescontext = context;
-    restore(ret);
-    context = pop();
-    return new_pair(res, rescontext);
+    arg = run_each(i, arg);
+    if (tail(arg) == i->null) return csx_run(i, head(arg));
+    push(i, i->context);
+    int ret = i->stacklen;
+    i->context = head(tail(arg));
+    void *res = csx_run(i, head(arg));
+    void *rescontext = i->context;
+    restore(i, ret);
+    i->context = pop(i);
+    return csx_pair(i, res, rescontext);
 }
 
 
-static void *zip(void *params, void *values)
+static void *zip(csxi *i, void *params, void *values)
 {
-    void *res = null;
-    while (type(params) == type_pair) {
-        res = new_pair(new_pair(head(params), head(values)), res);
+    void *res = i->null;
+    while (csx_obj(params)->type == i->basenames.pair) {
+        res = csx_pair(i, csx_pair(i, head(params), head(values)), res);
         params = tail(params);
         values = tail(values);
     }
-    if (type(params) == type_name)
-        res = new_pair(new_pair(params, values), res);
+    if (csx_obj(params)->type == i->basenames.name)
+        res = csx_pair(i, csx_pair(i, params, values), res);
     return res;
 }
 
-void *csx_run(void *arg)
+void *csx_run(csxi *i, void *arg)
 {
-    if (!initiated) init();
-    push(arg);
-    int ret = stacklen;
+    push(i, arg);
+    int ret = i->stacklen;
 tailcall:
-    gc();
-    if (type(arg) == type_name) {
-        restore(ret);
-        pop();
-        return lookup(arg);
-    } else if (type(arg) == type_pair) {
-        fn_data *fn = csx_run(head(arg));
+    gc(i);
+    if (csx_obj(arg)->type == i->basenames.name) {
+        restore(i, ret);
+        pop(i);
+        return lookup(i, arg);
+    } else if (csx_obj(arg)->type == i->basenames.pair) {
+        fn_data *fn = csx_run(i, head(arg));
         void *ops = tail(arg);
-        push(fn);
-        if (type(fn) == type_base) {
-            csx_base_data *base = (void *)fn;
+        push(i, fn);
+        if (csx_obj(fn)->type == i->basenames.base) {
+            csxbase *base = (void *)fn;
             if (*base == csx_run) {
-                ops = run_each(ops);
+                ops = run_each(i, ops);
                 arg = head(ops);
-                push(arg);
+                push(i, arg);
                 goto tailcall;
             } else {
-                void *res = (*base)(ops);
-                restore(ret);
-                pop();
+                void *res = (*base)(i, ops);
+                restore(i, ret);
+                pop(i);
                 return res;
             }
-        } else if (type(fn) == type_fn) {
+        } else if (csx_obj(fn)->type == i->basenames.fn) {
             void *res;
-            push(context);
-            int fnret = stacklen;
-            ops = run_each(ops);
-            context = new_pair(zip(fn->params, ops), fn->context);
-            res = base_do(fn->body);
-            restore(fnret);
-            context = pop();
-            restore(ret);
-            pop();
+            push(i, i->context);
+            int fnret = i->stacklen;
+            ops = run_each(i, ops);
+            i->context = csx_pair(i, zip(i, fn->params, ops), fn->context);
+            res = base_do(i, fn->body);
+            restore(i, fnret);
+            i->context = pop(i);
+            restore(i, ret);
+            pop(i);
             return res;
-        } else if (type(fn) == type_sx) {
-            push(context);
-            int sxret = stacklen;
-            context = new_pair(zip(fn->params, ops), fn->context);
-            arg = base_do(fn->body);
-            restore(sxret);
-            context = pop();
+        } else if (csx_obj(fn)->type == i->basenames.sx) {
+            push(i, i->context);
+            int sxret = i->stacklen;
+            i->context = csx_pair(i, zip(i, fn->params, ops), fn->context);
+            arg = base_do(i, fn->body);
+            restore(i, sxret);
+            i->context = pop(i);
             goto tailcall;
-        } else if (type(fn) == type_pair) {
-            pair_data *res = (void *)fn;
-            int pos = *(int *)csx_run(head(ops));
+        } else if (csx_obj(fn)->type == i->basenames.pair) {
+            csxpair *res = (void *)fn;
+            int pos = *(int *)csx_run(i, head(ops));
             while (pos--) res = res->tail;
-            restore(ret);
-            pop();
+            restore(i, ret);
+            pop(i);
             return res->head;
-        } else if (type(fn) == type_str) {
+        } else if (csx_obj(fn)->type == i->basenames.str) {
             char *res = (void *)fn;
-            int pos = *(int *)csx_run(head(ops));
-            restore(ret);
-            pop();
-            return csx_int(res[pos]);
-        } else if (type(fn) == type_null) {
-            restore(ret);
-            pop();
-            return null;
+            int pos = *(int *)csx_run(i, head(ops));
+            restore(i, ret);
+            pop(i);
+            return csx_int(i, res[pos]);
+        } else if (csx_obj(fn)->type == i->null) {
+            restore(i, ret);
+            pop(i);
+            return i->null;
         } else {
             exit(1);
         }
     }
-    restore(ret);
-    pop();
+    restore(i, ret);
+    pop(i);
     return arg;
 }
 
 
-static void *base_context(void *args)
-{
-    return context;
-}
+static void *base_context(csxi *i, void *args)  { return i->context; }
 
-static void new_context();
-static void *base_newcontext(void *args)
+static void new_context(csxi *i);
+static void *base_newcontext(csxi *i, void *args)
 {
-    push(context);
-    new_context();
-    void *res = context;
-    context = pop();
+    push(i, i->context);
+    new_context(i);
+    void *res = i->context;
+    i->context = pop(i);
     return res;
 }
 
-static void *base_exit(void *args)
+static void *base_exit(csxi *i, void *args)
 {
-    csx_free();
+    csx_free(i);
     exit(0);
 }
 
-static void new_context()
-{
-    context = new_pair(null, null);
-    base_set(csx_list(csx_name("set"), csx_base(base_set), 0));
-    base_set(csx_list(csx_name("set?"), csx_base(base_is_set), 0));
-    base_set(csx_list(csx_name("sethead"), csx_base(base_sethead), 0));
-    base_set(csx_list(csx_name("settail"), csx_base(base_settail), 0));
-    base_set(csx_list(csx_name("pair"), csx_base(base_pair), 0));
-    base_set(csx_list(csx_name("head"), csx_base(base_head), 0));
-    base_set(csx_list(csx_name("tail"), csx_base(base_tail), 0));
-    base_set(csx_list(csx_name("quote"), csx_base(base_quote), 0));
-    base_set(csx_list(csx_name("same"), csx_base(base_same), 0));
-    base_set(csx_list(csx_name("type"), csx_base(base_type), 0));
-    base_set(csx_list(csx_name("do"), csx_base(base_do), 0));
-    base_set(csx_list(csx_name("fn"), csx_base(base_fn), 0));
-    base_set(csx_list(csx_name("sx"), csx_base(base_sx), 0));
-    base_set(csx_list(csx_name("if"), csx_base(base_if), 0));
-    base_set(csx_list(csx_name("+"), csx_base(base_sum), 0));
-    base_set(csx_list(csx_name("*"), csx_base(base_prod), 0));
-    base_set(csx_list(csx_name("neg"), csx_base(base_neg), 0));
-    base_set(csx_list(csx_name("inv"), csx_base(base_inv), 0));
-    base_set(csx_list(csx_name("div"), csx_base(base_div), 0));
-    base_set(csx_list(csx_name("mod"), csx_base(base_mod), 0));
-    base_set(csx_list(csx_name("<"), csx_base(base_inc), 0));
-    base_set(csx_list(csx_name(">"), csx_base(base_dec), 0));
-    base_set(csx_list(csx_name("out"), csx_base(base_out), 0));
-    base_set(csx_list(csx_name("in"), csx_base(base_in), 0));
-    base_set(csx_list(csx_name("name"), csx_base(base_name), 0));
-    base_set(csx_list(csx_name("str"), csx_base(base_str), 0));
-    base_set(csx_list(csx_name("len"), csx_base(base_len), 0));
-    base_set(csx_list(csx_name("run"), csx_base(base_run), 0));
-    base_set(csx_list(csx_name("context"), csx_base(base_context), 0));
-    base_set(csx_list(csx_name("newcontext"), csx_base(base_newcontext), 0));
-    base_set(csx_list(csx_name("exit"), csx_base(base_exit), 0));
-}
-
-static void init()
-{
-    initiated = 1;
-    setbuf(stdin, 0);
-    setbuf(stdout, 0);
-    null = new(type_null, 0);
-    one = csx_int(1);
-    new_context();
-}
-
-void csx_free()
-{
-    initiated = 0;
-    while (objslen) {
-        free(objs[--objslen]);
+static void new_context(csxi *i)
+{
+    csxbasenames *n = &i->basenames;
+    i->context = csx_pair(i, i->null, i->null);
+    base_set(i, csx_list(i, n->set,        csx_base(i, base_set),        0));
+    base_set(i, csx_list(i, n->_isset,     csx_base(i, base_is_set),     0));
+    base_set(i, csx_list(i, n->sethead,    csx_base(i, base_sethead),    0));
+    base_set(i, csx_list(i, n->settail,    csx_base(i, base_settail),    0));
+    base_set(i, csx_list(i, n->pair,       csx_base(i, base_pair),       0));
+    base_set(i, csx_list(i, n->head,       csx_base(i, base_head),       0));
+    base_set(i, csx_list(i, n->tail,       csx_base(i, base_tail),       0));
+    base_set(i, csx_list(i, n->qt,         csx_base(i, base_qt),         0));
+    base_set(i, csx_list(i, n->same,       csx_base(i, base_same),       0));
+    base_set(i, csx_list(i, n->type,       csx_base(i, base_type),       0));
+    base_set(i, csx_list(i, n->_do,        csx_base(i, base_do),         0));
+    base_set(i, csx_list(i, n->fn,         csx_base(i, base_fn),         0));
+    base_set(i, csx_list(i, n->sx,         csx_base(i, base_sx),         0));
+    base_set(i, csx_list(i, n->_if,        csx_base(i, base_if),         0));
+    base_set(i, csx_list(i, n->_plus,      csx_base(i, base_sum),        0));
+    base_set(i, csx_list(i, n->_star,      csx_base(i, base_prod),       0));
+    base_set(i, csx_list(i, n->neg,        csx_base(i, base_neg),        0));
+    base_set(i, csx_list(i, n->div,        csx_base(i, base_div),        0));
+    base_set(i, csx_list(i, n->mod,        csx_base(i, base_mod),        0));
+    base_set(i, csx_list(i, n->_less,      csx_base(i, base_inc),        0));
+    base_set(i, csx_list(i, n->_more,      csx_base(i, base_dec),        0));
+    base_set(i, csx_list(i, n->out,        csx_base(i, base_out),        0));
+    base_set(i, csx_list(i, n->in,         csx_base(i, base_in),         0));
+    base_set(i, csx_list(i, n->name,       csx_base(i, base_name),       0));
+    base_set(i, csx_list(i, n->str,        csx_base(i, base_str),        0));
+    base_set(i, csx_list(i, n->len,        csx_base(i, base_len),        0));
+    base_set(i, csx_list(i, n->run,        csx_base(i, base_run),        0));
+    base_set(i, csx_list(i, n->context,    csx_base(i, base_context),    0));
+    base_set(i, csx_list(i, n->newcontext, csx_base(i, base_newcontext), 0));
+    base_set(i, csx_list(i, n->_exit,      csx_base(i, base_exit),       0));
+}
+
+static void init_the_name(csxi *csx)
+{
+    char *name = new(csx, 0, 5);
+    csx_obj(name)->type = name;
+    memcpy(name, "name", 5);
+    csx->basenames.name = name;
+}
+
+static char *init_basename(csxi *csx, const char *name)
+{
+    const int len = strlen(name);
+    char *res = new(csx, csx->basenames.name, len);
+    memcpy(res, name, len);
+    return res;
+}
+
+static void init_basenames(csxi *csx)
+{
+    csxbasenames *n = &csx->basenames;
+    n->pair       = init_basename(csx, "pair");
+    n->str        = init_basename(csx, "str");
+    n->_int       = init_basename(csx, "int");
+    n->base       = init_basename(csx, "base");
+    n->fn         = init_basename(csx, "fn");
+    n->sx         = init_basename(csx, "sx");
+    n->set        = init_basename(csx, "set");
+    n->_isset     = init_basename(csx, "set?");
+    n->sethead    = init_basename(csx, "sethead");
+    n->settail    = init_basename(csx, "settail");
+    n->head       = init_basename(csx, "head");
+    n->tail       = init_basename(csx, "tail");
+    n->qt         = init_basename(csx, "qt");
+    n->same       = init_basename(csx, "same");
+    n->type       = init_basename(csx, "type");
+    n->_do        = init_basename(csx, "do");
+    n->_if        = init_basename(csx, "if");
+    n->_plus      = init_basename(csx, "+");
+    n->_star      = init_basename(csx, "*");
+    n->neg        = init_basename(csx, "neg");
+    n->div        = init_basename(csx, "div");
+    n->mod        = init_basename(csx, "mod");
+    n->_less      = init_basename(csx, "<");
+    n->_more      = init_basename(csx, ">");
+    n->out        = init_basename(csx, "out");
+    n->in         = init_basename(csx, "in");
+    n->len        = init_basename(csx, "len");
+    n->run        = init_basename(csx, "run");
+    n->context    = init_basename(csx, "context");
+    n->newcontext = init_basename(csx, "newcontext");
+    n->_exit      = init_basename(csx, "exit");
+}
+
+
+void csx_init(csxi *csx)
+{
+    csx->objs = 0;
+    csx->objslen = 0;
+    csx->objssize = 0;
+    csx->stack = 0;
+    csx->stacklen = 0;
+    csx->stacksize = 0;
+    csx->lastlen = 0;
+    csx->context = 0;
+    init_the_name(csx);
+    init_basenames(csx);
+    csx->null = new(csx, 0, 0);
+    csx_obj(csx->null)->type = csx->null;
+    csx->one = csx_int(csx, 1);
+    new_context(csx);
+}
+
+void csx_free(csxi *csx)
+{
+    while (csx->objslen) {
+        free(csx->objs[--(csx->objslen)]);
     }
-    free(objs);
-    free(stack);
-    objs = 0;
-    stack = 0;
+    free(csx->objs);
+    free(csx->stack);
 }
 
 
-void *csx_list(void *head, ...)
+csxpair *csx_list(csxi *csx, void *head, ...)
 {
     va_list args;
-    pair_data *res;
-    pair_data **p;
-    if (!initiated) init();
-    if (!head) return null;
-    res = new_pair(head, null);
-    p = (pair_data **)&res->tail;
+    csxpair *res;
+    csxpair **p;
+    if (!head) return csx->null;
+    res = csx_pair(csx, head, csx->null);
+    p = (csxpair **)&res->tail;
     va_start(args, head);
     for (head = va_arg(args, void *); head; head = va_arg(args, void *)) {
-        *p = new_pair(head, null);
-        p = (pair_data **)&(*p)->tail;
+        *p = csx_pair(csx, head, csx->null);
+        p = (csxpair **)&(*p)->tail;
     }
     va_end(args);
     return res;
 }
 
-void *csx_pair(void *a, void *b, void *c, ...)
+csxpair *csx_dot(csxi *csx, void *a, void *b, void *c, ...)
 {
     va_list args;
-    pair_data *res;
-    pair_data **p;
-    if (!initiated) init();
-    if (!c) return new_pair(a, b);
-    res = new_pair(a, b);
-    p = (pair_data **)&res->tail;
-    *p = new_pair(*p, c);
-    p = (pair_data **)&(*p)->tail;
+    csxpair *res;
+    csxpair **p;
+    if (!c) return csx_pair(csx, a, b);
+    res = csx_pair(csx, a, b);
+    p = (csxpair **)&res->tail;
+    *p = csx_pair(csx, *p, c);
+    p = (csxpair **)&(*p)->tail;
     va_start(args, c);
     for (c = va_arg(args, void *); c; c = va_arg(args, void *)) {
-        *p = new_pair(*p, c);
-        p = (pair_data **)&(*p)->tail;
+        *p = csx_pair(csx, *p, c);
+        p = (csxpair **)&(*p)->tail;
     }
     va_end(args);
     return res;
 }
 
-char *csx_str(const char *str)
+char *csx_str(csxi *csx, const char *str)
 {
-    if (!initiated) init();
-    int strsize = strlen(str) + 1;
-    char *res = new(type_str, strsize);
+    const int strsize = strlen(str) + 1;
+    char *res = new(csx, csx->basenames.str, strsize);
     memcpy(res, str, strsize);
     return res;
 }
diff --git a/src/csxbind.c b/src/csxbind.c
new file mode 100644
index 0000000..8e31585
--- /dev/null
+++ b/src/csxbind.c
@@ -0,0 +1,143 @@
+#include "csxbind.h"
+
+#include <stdarg.h>
+
+
+char *name;
+char *pair;
+char *str;
+char *_int;
+char *base;
+char *fn;
+char *sx;
+char *set;
+char *_isset;
+char *sethead;
+char *settail;
+char *head;
+char *tail;
+char *qt;
+char *same;
+char *type;
+char *_do;
+char *_if;
+char *_plus;
+char *_star;
+char *neg;
+char *div;
+char *mod;
+char *_less;
+char *_more;
+char *out;
+char *in;
+char *len;
+char *run;
+char *context;
+char *newcontext;
+char *_exit;
+
+
+static csxi csx;
+static int initialised = 0;
+
+
+void init()
+{
+    initialised = 1;
+    csx_init(&csx);
+    csxbasenames *n = &csx.basenames;
+    name       = n->name;
+    pair       = n->pair;
+    str        = n->str;
+    _int       = n->_int;
+    base       = n->base;
+    fn         = n->fn;
+    sx         = n->sx;
+    set        = n->set;
+    _isset     = n->_isset;
+    sethead    = n->sethead;
+    settail    = n->settail;
+    head       = n->tail;
+    tail       = n->tail;
+    qt         = n->qt;
+    same       = n->same;
+    type       = n->type;
+    _do        = n->_do;
+    _if        = n->_if;
+    _plus      = n->_plus;
+    _star      = n->_star;
+    neg        = n->neg;
+    div        = n->div;
+    mod        = n->mod;
+    _less      = n->_less;
+    _more      = n->_more;
+    out        = n->out;
+    in         = n->in;
+    len        = n->len;
+    run        = n->run;
+    context    = n->context;
+    newcontext = n->newcontext;
+    _exit      = n->_exit;
+}
+
+
+csxpair *L(void *head, ...)
+{
+    va_list args;
+    csxpair *res;
+    csxpair **p;
+    if (!head) return csx.null;
+    res = csx_pair(&csx, head, csx.null);
+    p = (csxpair **)&res->tail;
+    va_start(args, head);
+    for (head = va_arg(args, void *); head; head = va_arg(args, void *)) {
+        *p = csx_pair(&csx, head, csx.null);
+        p = (csxpair **)&(*p)->tail;
+    }
+    va_end(args);
+    return res;
+}
+csxpair *D(void *a, void *b, void *c, ...)
+{
+    va_list args;
+    csxpair *res;
+    csxpair **p;
+    if (!c) return csx_pair(&csx, a, b);
+    res = csx_pair(&csx, a, b);
+    p = (csxpair **)&res->tail;
+    *p = csx_pair(&csx, *p, c);
+    p = (csxpair **)&(*p)->tail;
+    va_start(args, c);
+    for (c = va_arg(args, void *); c; c = va_arg(args, void *)) {
+        *p = csx_pair(&csx, *p, c);
+        p = (csxpair **)&(*p)->tail;
+    }
+    va_end(args);
+    return res;
+}
+csxpair *P(void *head, void *tail)
+{
+    return csx_pair(&csx, head, tail);
+}
+char *N(const char *name)
+{
+    return csx_name(&csx, name);
+}
+char *S(const char *str)
+{
+    return csx_str(&csx, str);
+}
+int *I(int num)
+{
+    return csx_int(&csx, num);
+}
+
+void *R(void *expression)
+{
+    return csx_run(&csx, expression);
+}
+
+csxbase *newbase(csxbase base)
+{
+    return csx_base(&csx, base);
+}
-- 
cgit v1.2.3