From 1afd0cdc7820d9c3a9ae032ea40545d7d32bf9bf Mon Sep 17 00:00:00 2001
From: Aleksey Veresov <aleksey@veresov.pro>
Date: Tue, 5 Jan 2021 22:16:50 +0300
Subject: String type added.

---
 examples/generated.csx | 100 ++++++++++++++++++-------------
 examples/translator.c  | 160 +++++++++++++++++++++++++------------------------
 include/csx.h          |   9 ++-
 src/csx.c              |  97 ++++++++++++++++++++++++------
 4 files changed, 227 insertions(+), 139 deletions(-)

diff --git a/examples/generated.csx b/examples/generated.csx
index 14943b2..62fd2eb 100644
--- a/examples/generated.csx
+++ b/examples/generated.csx
@@ -1,47 +1,67 @@
+{ Base Utilities }
+
 [set no [fn [x] [same x []]]]
-[set outint [fn [n] [if [< n 0]
-  [do [out 45] [outint [neg n]]]
-  [if [< n 10]
-    [out [+ 48 n]]
-    [do
-      [outint [div n 10]]
-      [out [+ 48 [mod n 10]]]
+[set id [fn [arg] arg]]
+[set list [fn args args]]
+
+[set catrev [fn [a b] [if a [catrev [tail a] [pair [head a] b]] b]]]
+[set rev [fn [l] [catrev l []]]]
+[set cat [fn [a b] [catrev [rev a] b]]]
+
+[set map [fn [f l] [if l [pair [f [head l]] [map f [tail l]]]]]]
+[set reduce [fn [f l] [if [no l] [] [if [no [tail l]] [head l]
+  [f [head l] [reduce f [tail l]]]
+]]]]
+
+[set - [fn =[a rest] [+ a [reduce + [map neg rest]]]]]
+
+
+{ Input-Output }
+
+[set newline [str [list 10]]]
+
+[set outint [fn [n]
+  [set zero 48]
+  [set minus 45]
+  [if [< n 0]
+    [do [out minus] [outint [neg n]]]
+    [if [< n 10]
+      [out [+ zero n]]
+      [do
+        [outint [div n 10]]
+        [out [+ zero [mod n 10]]]
+      ]
     ]
   ]
-]]]
-[set map [fn [f l] [if l [pair [f [head l]] [map f [tail l]]]]]]
-[set id [fn args args]]
-[set outstr [fn [str] [if str [do [out [head str]] [outstr [tail str]]]]]]
-[set newline [fn [] [out 10]]]
-[set instr [fn []
-  [set c [in]]
-  [if [no [same c 10]] [pair c [instr]]]
 ]]
-[set outints [fn [l]
-  [set outcontent [fn [l]
-    [if l [do [outint [head l]] [out 32] [outcontent [tail l]]]]
+
+[set outstr [fn [str]
+  [set outstrat [fn [str i len] [if [no [same i len]] [do
+    [out [str i]]
+    [outstrat str [+ i 1] len]
+  ]]]]
+  [outstrat str 0 [len str]]
+]]
+
+[set output [fn objs [map [fn [obj] [if
+  [same [type obj] 'int] [outint obj]
+  [same [type obj] 'str] [outstr obj]
+]] objs]]]
+
+[set instr [fn []
+  [set instract [fn []
+    [set c [in]]
+    [if [no [same c 10]] [pair c [instract]]]
   ]]
-  [out 91] [outcontent l] [out 93]
+  [str [instract]]
 ]]
-[set rappend [fn [a b] [if a [rappend [tail a] [pair [head a] b]] b]]]
-[set rev [fn [l] [rappend l []]]]
-[set append [fn [a b] [rappend [rev a] b]]]
-[set backwards [sx body [pair 'do [rev body]]]]
-
-[outstr "-= loaded =-"]
-[newline]
-[outstr "Hello, I am Casey Shawn Exton.  What is your name?"]
-[newline]
-[outstr "> "]
+
+
+{ The Program }
+
+[output "Hello, I am Casey Shawn Exton.  " "What is your name?" newline]
+[output "> "]
 [set name [instr]]
-[outstr "Nice to meet you, "]
-[outstr name]
-[outstr "."]
-[newline]
-[outstr "I have to go.  Goodbye!"]
-[newline]
-
-[backwards
-  [outstr magic]
-  [set magic [rev "magic"]]
-]
+[output "Nice to meet you, " name "." newline]
+[output "Your name is " [len name] " characters long." newline]
+[output "I have to go.  Goodbye!" newline]
diff --git a/examples/translator.c b/examples/translator.c
index 29f4d4e..01920c9 100644
--- a/examples/translator.c
+++ b/examples/translator.c
@@ -3,42 +3,83 @@
 #include <stdlib.h>
 
 
-void readlist()
+int c;
+
+
+void items();
+
+void name(char a)
+{
+    printf("csx_name(\"");
+    if (a) putchar(a);
+    while (c != EOF && !isspace(c) && c != '[' && c != ']') {
+        if (c == '"' || c == '\\') putchar('\\');
+        putchar(c);
+        c = getchar();
+    }
+    printf("\")");
+}
+
+void num(char a)
+{
+    printf("csx_int(");
+    if (a) putchar(a);
+    c = getchar();
+    while (c != EOF && isdigit(c)) {
+        putchar(c);
+        c = getchar();
+    }
+    printf(")");
+}
+
+void pair()
+{
+    if ((c = getchar()) == '[') {
+        printf("csx_pair(");
+        items();
+        printf("0)");
+        c = getchar();
+    } else name('=');
+}
+
+void list()
+{
+    printf("csx_list(");
+    items();
+    printf("0)");
+    c = getchar();
+}
+
+void skip()
+{
+    while (isspace(c) || c == '{') {
+        if (isspace(c)) while (isspace(c = getchar()));
+        if (c == '{') {
+            int level = 1;
+            while (level && c != EOF) {
+                while ((c = getchar()) != '{' && c != '}' && c != EOF);
+                if (c == '{') ++level;
+                if (c == '}') --level;
+            }
+            if (c != EOF) c = getchar();
+        }
+    }
+}
+
+void items()
 {
     int first = 1;
-    int c = getchar();
+    c = getchar();
+    skip();
     while (c != EOF && c != ']') {
-        if (c == '[') {
-            if (first) first = 0;
-            else putchar(',');
-            printf("csx_list(");
-            readlist();
-            printf("0)");
-            c = getchar();
-        } else if (isdigit(c) || c == '-') {
-            if (first) first = 0;
-            else putchar(',');
-            printf("csx_int(");
-            putchar(c);
-            c = getchar();
-            while (c != EOF && isdigit(c)) {
-                putchar(c);
-                c = getchar();
-            }
-            printf(")");
-        } else if (isspace(c)) {
-            while (isspace(c = getchar()));
-        } else if (c == '.') {
-            if (getchar() != '[') exit(1);
-            if (first) first = 0;
-            else putchar(',');
-            printf("csx_dot(");
-            readlist();
-            printf("0)");
-            c = getchar();
-        } else if (c == '"') {
-            if (first) first = 0;
-            else putchar(',');
+        if (first) first = 0; else putchar(',');
+        if (c == '[') list();
+        else if (c == '-')
+            if (isdigit(c = getchar())) num('-');
+            else name('-');
+        else if (isdigit(c)) num(c);
+        else if (c == '=') pair();
+        else if (c == '"') {
             printf("csx_str(\"");
             c = getchar();
             while (c != EOF && c != '"') {
@@ -50,57 +91,22 @@ void readlist()
             printf("\")");
             c = getchar();
         } else if (c == '\'') {
-            if (first) first = 0;
-            else putchar(',');
             printf("csx_list(csx_name(\"quote\"),");
             c = getchar();
-            if (isspace(c)) exit(1);
-            else if (c != '[') {
-                printf("csx_name(\"");
-                while (c != EOF && !isspace(c) && c != '[' && c != ']') {
-                    if (c == '"' || c == '\\') putchar('\\');
-                    putchar(c);
-                    c = getchar();
-                }
-                printf("\"),");
-            } else if (c == '.') {
-                if (getchar() != '[') exit(1);
-                printf("csx_dot(");
-                readlist();
-                printf("0)");
-                c = getchar();
-            } else {
-                printf("csx_list(");
-                readlist();
-                printf("0),");
-                c = getchar();
-            }
-            printf("0)");
-        } else {
-            if (first) first = 0;
-            else putchar(',');
-            printf("csx_name(\"");
-            while (c != EOF && !isspace(c) && c != '[' && c != ']') {
-                if (c == '\\') c = getchar();
-                if (c == '"' || c == '\\') putchar('\\');
-                putchar(c);
-                c = getchar();
-            }
-            printf("\")");
-        }
+            if (c == '[') list();
+            else if (c == '=') pair();
+            else name(0);
+            printf(",0)");
+        } else name(0);
+        skip();
     }
     if (!first) putchar(',');
 }
 
 int main()
 {
-    puts("#include <csx.h>");
-    puts("int main()");
-    puts("{");
-    printf("csx_run(csx_list(csx_name(\"do\"),");
-    readlist();
-    puts("0));");
-    puts("return 0;");
-    puts("}");
+    printf("#include <csx.h>\nint main(){csx_run(csx_list(csx_name(\"do\"),");
+    items();
+    printf("0));return 0;}\n");
     return 0;
 }
diff --git a/include/csx.h b/include/csx.h
index 8d1e8f0..20f31fd 100644
--- a/include/csx.h
+++ b/include/csx.h
@@ -5,12 +5,15 @@
 typedef void *(csx_list_fn)(void *head, ...);
 void *csx_list(void *head, ...);
 
-typedef void *(csx_dot_fn)(void *a, void *b, void *c, ...);
-void *csx_dot(void *a, void *b, void *c, ...);
+typedef void *(csx_pair_fn)(void *a, void *b, void *c, ...);
+void *csx_pair(void *a, void *b, void *c, ...);
 
 typedef int *(csx_int_fn)(int num);
 int *csx_int(int num);
 
+typedef double *(csx_float_fn)(double num);
+double *csx_float(double num);
+
 void *csx_run(void *expression);
 
 typedef void *(*csx_base_data)(void *arg);
@@ -18,7 +21,7 @@ csx_base_data *csx_base(csx_base_data base);
 
 char *csx_name(const char *name);
 
-void *csx_str(const char *str);
+char *csx_str(const char *str);
 
 
 #endif
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;
 }
-- 
cgit v1.2.3