Something...

5 files changed, 246 insertions, 71 deletions

diff --git a/README b/README
index bac93d8..769598e 100644
--- a/README
+++ b/README
@@ -16,4 +16,4 @@ Descriptions and details are in corresponding source files.
 ...
 
     Motivation
-You can do such things in C, this fact should be more known.
+You can do such things in C and this fact should be better known.
diff --git a/examples/math.c b/examples/math.c
deleted file mode 100644
index df0aabc..0000000
--- a/examples/math.c
+++ /dev/null
@@ -1,70 +0,0 @@
-#include <csx.h>
-
-
-v def_rat_sum(v construct, v numer, v denom)
-{
-    v a = atom("a");
-    v b = atom("b");
-    return el(define, l(atom("rat_sum"), a, b),
-        l(construct, l(sum, l(mul, l(numer, a), l(denom, b)),
-                            l(mul, l(numer, b), l(denom, a))),
-                     l(mul, l(denom, a), l(denom, b)))
-    );
-}
-
-v def_rat_sum(v construct, v numer, v denom)
-{
-    v a = atom("a");
-    v b = atom("b");
-    return el(define, l(atom("rat_sub"), a, b),
-        l(construct, l(sub, l(mul, l(numer, a), l(denom, b)),
-                            l(mul, l(numer, b), l(denom, a))),
-                     l(mul, l(denom, a), l(denom, b)))
-    );
-}
-
-v def_rat_equ(v construct, v numer, v denom)
-{
-    v a = atom("a");
-    v b = atom("b");
-    return el(define, l(atom("rat_equ"), a, b),
-        l(equ, l(mul, l(numer, a), l(denom, b)),
-               l(mul, l(numer, b), l(denom, a)))
-    );
-}
-
-void printres(v a, v b, v absum, v absub, int *are_equ, v numer, v denom)
-{
-    int an   = *(int *)el(numer, a);
-    int ad   = *(int *)el(denom, a);
-    int bn   = *(int *)el(numer, b);
-    int bd   = *(int *)el(denom, b);
-    int sumn = *(int *)el(numer, absum);
-    int sumd = *(int *)el(denom, absum);
-    int subn = *(int *)el(numer, absub);
-    int subd = *(int *)el(denom, absub);
-    printf("%d/%d + %d/%d = %d/%d\n", an, ad, bn, bd, sumn, sumd);
-    printf("%d/%d - %d/%d = %d/%d\n", an, ad, bn, bd, subn, subd);
-    if (*are_equ) {
-        puts("And they are equal.\n");
-    } else {
-        puts("And they are not equal.\n");
-    }
-}
-
-int main()
-{
-    v rat       = l(define, atom("rat"), cons);
-    v rat_numer = l(define, atom("rat_numer"), car);
-    v rat_denom = l(define, atom("rat_denom"), cdr);
-    v rat_sum   = def_rat_sum(rat, rat_numer, rat_denom);
-    v rat_sub   = def_rat_sub(rat, rat_numer, rat_denom);
-    v rat_equ   = def_rat_equ(rat, rat_numer, rat_denom);
-    v number_a  = el(rat, n(19), n(99));
-    v number_b  = el(rat, n(7), n(3));
-    v absum     = el(rat_sum, number_a, number_b);
-    v absub     = el(rat_sub, number_a, number_b);
-    v are_equ   = el(rat_equ, number_a, number_b);
-    printres(number_a, number_b, sum, sub, are_equ, numer, denom);
-    return 0;
-}
diff --git a/examples/strfib.c b/examples/strfib.c
new file mode 100644
index 0000000..6e22c7f
--- /dev/null
+++ b/examples/strfib.c
@@ -0,0 +1,53 @@
+#include <csx/csx.h>
+#include <stdio.h>
+
+
+static csx_type_function_list     *l;
+static csx_type_function_string   *s;
+static csx_type_function_atom     *a;
+static csx_type_function_evaluate *e;
+
+static char *append;
+static char *define;
+static char *cdr;
+static char *ifx;
+static char *not;
+
+void printfibs(char *strfib)
+{
+    const char *input = "oooooooooo" + 9;
+    int i;
+    for (i = 0; i != 10; ++i)
+        puts(e(l(strfib, s(input - i), 0)));
+}
+
+void process()
+{
+    char *strfib   = a("strfib");
+    char *n        = a("n");
+    e(l(define, l(strfib, n, 0),
+        l(ifx, l(not, n, 0), s(""),
+            l(ifx, l(not, l(cdr, n, 0), 0), s("o"),
+                l(append, l(strfib, l(cdr, n, 0), 0),
+                          l(strfib, l(cdr, l(cdr, n, 0), 0), 0), 0),
+            0),
+        0),
+    0));
+    printfibs(strfib);
+}
+
+int main()
+{
+    l = csx_list;
+    s = csx_string;
+    a = csx_atom;
+    e = csx_evaluate;
+    append = a("append");
+    define = a("define");
+    cdr    = a("cdr");
+    ifx    = a("ifx");
+    not    = a("not");
+    process();
+    csx_free();
+    return 0;
+}
diff --git a/include/csx/csx.h b/include/csx/csx.h
new file mode 100644
index 0000000..db2d1b3
--- /dev/null
+++ b/include/csx/csx.h
@@ -0,0 +1,25 @@
+#ifndef CSX_INCLUDED
+#define CSX_INCLUDED
+
+
+struct csx_pair {
+    void *car;
+    void *cdr;
+};
+
+typedef struct csx_pair *(csx_type_function_list)(void *head, ...);
+struct csx_pair *csx_list(void *head, ...);
+
+typedef char *(csx_type_function_string)(const char *string);
+char *csx_string(const char *string);
+
+typedef char *(csx_type_function_atom)(const char *name);
+char *csx_atom(const char *name);
+
+typedef void *(csx_type_function_evaluate)(void *expression);
+void *csx_evaluate(void *expression);
+
+void csx_free();
+
+
+#endif
diff --git a/src/csx.c b/src/csx.c
new file mode 100644
index 0000000..b6b0d38
--- /dev/null
+++ b/src/csx.c
@@ -0,0 +1,167 @@
+#include "csx.h"
+
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+
+
+enum { type_nil, type_pair, type_string, type_atom, type_fn };
+static int  *type(char *p)         { return (int *) (p - sizeof(int)); }
+static void  type_shift(void *p)  { *(char **)p += sizeof(int); }
+static void *type_alloc(int t, int content_size)
+{
+    int *res = malloc(sizeof(int) + content_size);
+    *res     = t;
+    type_shift(&res);
+    return res;
+}
+
+
+struct deflist {
+    char *atom;
+    void *data;
+    struct deflist *next;
+};
+
+static struct state {
+    struct deflist *atoms;
+} csx;
+static int csx_to_init = 0;
+
+static void *nil;
+
+
+static void adddef(struct deflist **l, const char *atom, void *data)
+{
+    struct deflist *old = *l;
+    *l = malloc(sizeof(**l));
+    (*l)->next = old;
+    (*l)->atom = scopy(atom);
+    (*l)->data = data;
+}
+
+static void *csx_fn_new(void *fn, void *userdata, int size)
+{
+    void *res = malloc(sizeof(fn) + sizeof(int) + size);
+    *(void **)res = fn;
+    (char *)res += sizeof(fn);
+    *(int *)res = type_fn;
+    typeshift(&res);
+    if (userdata && size) memcpy(res, userdata, size);
+    return res;
+}
+
+static void *define(void *userdata, struct csx_pair *data)
+{  /* TODO! */
+    int t = *type(data);
+    if (t != type_pair) return nil;
+    t = *type(data->car);
+    if (t == type_atom) {
+        struct csx_pair *cdr = data->cdr;
+        if (*type(cdr) != type_pair || *type(cdr->cdr) != type_nil)
+            return nil;
+        return define_constant(data->car, cdr->cdr);
+    }
+    return define_function(data->car, data->cdr);
+}
+
+/* TODO append, cdr, ... */
+
+static void csx_init()
+{
+    if (!csx_to_init) csx_free();
+    csx.atoms = 0;
+
+    nil = type_alloc(type_nil, 0);
+    adddef(csx.atoms, "append", csx_fn_new(append, 0, 0));
+    adddef(csx.atoms, "define", csx_fn_new(define, 0, 0));
+    adddef(csx.atoms, "cdr",    csx_fn_new(cdr,    0, 0));
+    adddef(csx.atoms, "ifx",    csx_fn_new(ifx,    0, 0));
+    adddef(csx.atoms, "not",    csx_fn_new(not,    0, 0));
+}
+
+void csx_free()
+{
+    free(nil);
+    /* free everything allocated */
+    csx_to_init = 0;
+}
+
+
+struct csx_pair *csx_pair_new(void *car, void *cdr)
+{
+    struct csx_pair *res =type_alloc(type_pair, sizeof(*res));
+    res->car = car;
+    res->cdr = cdr;
+    return res;
+}
+
+
+struct csx_pair *csx_list(void *head, ...)
+{
+    struct csx_pair *res;
+    va_list args;
+    if (csx_to_init) csx_init();
+    if (!head) return nil;
+
+    res = csx_pair_new(head, nil);
+    va_start(args, head);
+    for (head = va_arg(args, void *); head; head = va_arg(args, void *)) {
+        res->cdr = csx_pair_new(head, nil);
+    }
+    va_end(args);
+    return res;
+}
+
+char *csx_string(const char *string)
+{
+    int   strsize;
+    void *res;
+    if (csx_to_init) csx_init();
+    strsize = strlen(string) + 1;
+    res     = type_alloc(type_string, strsize);
+    memcpy(res, string, strsize);
+    return res;
+}
+
+char *csx_atom(const char *name)
+{
+    int   namesize;
+    void *res;
+    if (csx_to_init) csx_init();
+    namesize = strlen(name) + 1;
+    res      = type_alloc(type_atom, namesize);
+    memcpy(res, name, namesize);
+    return res;
+}
+
+
+static void *lookup(struct deflist *d, char *atom)
+{
+    if (!d) return nil;
+    if (!strcmp(d->atom, atom)) return d->data;
+    return lookup(d->next, atom);
+}
+
+void *eval_fn(void *fn, void *args)
+{  /* TODO! */
+    /* function : type :> userdata */
+    return 0;
+}
+
+static void *eval_pair(struct csx_pair *pair)
+{
+    void *fn;
+    int t = *type(pair->car);
+    if (t == type_fn) fn = pair->car;
+    else              fn = csx_evaluate(pair->car);
+    return eval_fn(fn, pair->cdr);
+}
+
+void *csx_evaluate(void *expression)
+{
+    int t = *type(expression);
+    if (t == type_atom) return lookup(csx.atoms, expression);
+    if (t != type_pair) return nil;
+    return eval_pair(expression);
+}