String type added.

1 files changed, 78 insertions, 19 deletions

diff --git a/src/csx.c b/src/csx.c
index 8951a09..0f07713 100644
--- a/src/csx.c
+++ b/src/csx.c
@@ -15,8 +15,10 @@ typedef enum csx_type {
     type_name,
     type_base,
     type_int,
+    type_real,
     type_fn,
-    type_sx
+    type_sx,
+    type_str
 } csx_type;
 
 static csx_type type(void *p)
@@ -63,6 +65,7 @@ static void *one;
 static pair_data *context;
 static pair_data *names;
 static pair_data *ints;
+static pair_data *reals;
 
 
 char *csx_name(const char *name)
@@ -102,6 +105,20 @@ int *csx_int(int num)
     return res;
 }
 
+double *csx_float(double num)
+{
+    if (!initiated) init();
+    pair_data *p = reals;
+    while (type(p) == type_pair) {
+        if (*(double *)p->head == num) return p->head;
+        p = p->tail;
+    }
+    double *res = new(type_real, sizeof(double));
+    *res = num;
+    ints = new_pair(res, ints);
+    return res;
+}
+
 
 static void *run_each(void *l)
 {
@@ -142,7 +159,7 @@ static void *lookup(const char *name)
         context = context->tail;
     }
     context = saved;
-    return 0;
+    return null;
 }
 
 static void *base_set(void *arg)
@@ -216,14 +233,17 @@ static void *base_same(void *arg)
 
 static void *base_type(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;
 }
@@ -263,7 +283,7 @@ static void *base_if(void *arg)
     if (type(tail(arg)) != type_pair) return csx_run(head(arg));
     return type(csx_run(head(arg))) != type_null ?
         csx_run(head(tail(arg))) :
-        csx_run(head(tail(tail(arg))));
+        base_if(tail(tail(arg)));
 }
 
 
@@ -362,6 +382,45 @@ static void *base_in(void *arg)
     return res != EOF ? csx_int(res) : null;
 }
 
+static void *base_name(void *arg)
+{
+    arg = run_each(arg);
+    if (type(head(arg)) != type_str) exit(1);
+    return csx_name(head(arg));
+}
+
+static void *base_str(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);
+    int reslen = 0;
+    char *res = malloc(1);
+    arg = head(arg);
+    while (type(arg) == type_pair) {
+        res[reslen] = *(char *)head(arg);
+        res = realloc(res, ++reslen + 1);
+        arg = tail(arg);
+    }
+    res[reslen] = 0;
+    return csx_str(res);
+}
+
+static void *base_len(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);
+    int len = 0;
+    arg = head(arg);
+    while (type(arg) == type_pair) {
+        arg = tail(arg);
+        ++len;
+    }
+    return csx_int(len);
+}
+
 
 static void *zip(void *params, void *values)
 {
@@ -380,11 +439,8 @@ void *csx_run(void *arg)
 {
     if (!initiated) init();
 tailcall:
-    if (type(arg) == type_name) {
-        void *r = lookup(arg);
-        if (!r) exit(1);
-        return r;
-    } else if (type(arg) == type_pair) {
+    if (type(arg) == type_name) return lookup(arg);
+    else if (type(arg) == type_pair) {
         fn_data *fn = csx_run(head(arg));
         void *ops = tail(arg);
         if (type(fn) == type_base) {
@@ -412,9 +468,13 @@ tailcall:
             goto tailcall;
         } else if (type(fn) == type_pair) {
             pair_data *res = (void *)fn;
-            int pos = *(int *)head(ops);
+            int pos = *(int *)csx_run(head(ops));
             while (pos--) res = res->tail;
             return res->head;
+        } else if (type(fn) == type_str) {
+            char *res = (void *)fn;
+            int pos = *(int *)csx_run(head(ops));
+            return csx_int(res[pos]);
         } else if (type(fn) == type_null) {
             return null;
         } else {
@@ -452,6 +512,9 @@ static void new_context()
     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(csx_run), 0));
 }
 
@@ -486,7 +549,7 @@ void *csx_list(void *head, ...)
     return res;
 }
 
-void *csx_dot(void *a, void *b, void *c, ...)
+void *csx_pair(void *a, void *b, void *c, ...)
 {
     va_list args;
     pair_data *res;
@@ -506,15 +569,11 @@ void *csx_dot(void *a, void *b, void *c, ...)
     return res;
 }
 
-void *csx_str(const char *str)
+char *csx_str(const char *str)
 {
     if (!initiated) init();
-    if (!str || !*str) return null;
-    pair_data *res = new_pair(csx_int(*str), null);
-    pair_data **p = (pair_data **)&res->tail;
-    while (*++str) {
-        *p = new_pair(csx_int(*str), null);
-        p = (pair_data **)&(*p)->tail;
-    }
-    return new_pair(csx_name("quote"), new_pair(res, null));
+    int strsize = strlen(str) + 1;
+    char *res = new(type_str, strsize);
+    memcpy(res, str, strsize);
+    return res;
 }