add format

4 files changed, 111 insertions, 5 deletions

diff --git a/src/builtins.c b/src/builtins.c
index 88bcc9b..9a35f52 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -1,6 +1,86 @@
 #include "builtins.h"
 #include "interp.h"
 #include "sexp.h"
+#include <algds/str.h>
+
+SExpRef builtin_format(Interp *interp, SExpRef args) {
+    if (NILP(args)) {
+        return new_error(interp, "format: too few arguments (missing format string).\n");
+    }
+
+    SExpRef format_string_sexp = CAR(args);
+    SExpRef format_args = CDR(args);
+
+    if (REF(format_string_sexp)->type != kStringSExp) {
+        return new_error(interp, "format: first argument must be a string.\n");
+    }
+
+    const char *format_str = REF(format_string_sexp)->str;
+    str_builder_t sb;
+    SExpRef ret;
+    init_str_builder(&sb);
+
+    SExpRef current_format_arg = format_args;
+    for (int i = 0; format_str[i] != '\0'; ++i) {
+        if (format_str[i] == '%' && format_str[i+1] == 's') {
+            if (NILP(current_format_arg)) {
+                ret = new_error(interp, "format: wrong argument number.\n");
+                goto end;
+            } else {
+                SExpRef s_arg = CAR(current_format_arg);
+                if (REF(s_arg)->type != kStringSExp) {
+                    const char *s = lisp_to_string(interp, s_arg);
+                    str_builder_append(&sb, "%s", s);
+                    free((void*)s);
+                } else {
+                    str_builder_append(&sb, "%s", REF(s_arg)->str);
+                }
+                current_format_arg = CDR(current_format_arg);
+                i++;
+            }
+        } else if (format_str[i] == '%' && format_str[i+1] == '%') {
+            str_builder_append_char(&sb, '%');
+            i++;
+        } else if (format_str[i] == '%') {
+            ret = new_error(interp, "format: only %%s is supported.\n");
+            goto end;
+        } else {
+            str_builder_append_char(&sb, format_str[i]);
+        }
+    }
+    if (!NILP(current_format_arg)) {
+        ret = new_error(interp, "format: wrong argument number.\n");
+        goto end;
+    }
+
+    str_builder_append_char(&sb, '\0');
+    ret = new_string(interp, sb.buf);
+end:
+    free(sb.buf);
+    return ret;
+}
+
+SExpRef builtin_concat(Interp *interp, SExpRef args) {
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kStringSExp) {
+            return new_error(interp, "concat: wrong type.\n");
+        }
+        cur = CDR(cur);
+    }
+    str_builder_t sb;
+    init_str_builder(&sb);
+    cur = args;
+    while (!NILP(cur)) {
+        SExpRef s = CAR(cur);
+        str_builder_append(&sb, "%s", REF(s)->str);
+        cur = CDR(cur);
+    }
+    str_builder_append_char(&sb, '\0');
+    SExpRef ret = new_string(interp, sb.buf);
+    free(sb.buf);
+    return ret;
+}
 
 SExpRef builtin_exit(Interp *interp, SExpRef args) {
     if (LENGTH(args) == 0) {
@@ -41,7 +121,21 @@ SExpRef builtin_car(Interp *interp, SExpRef args) {
     return CAR(CAR(args));
 }
 
-SExpRef builtin_show(Interp *interp, SExpRef args) {
+SExpRef builtin_princ(Interp *interp, SExpRef args) {
+    if (LENGTH(args) != 1) {
+        return new_error(interp, "show wrong argument number.\n");
+    }
+    if (VALTYPE(CAR(args)) == kStringSExp) {
+        printf("%s", REF(CAR(args))->str);
+        return NIL;
+    }
+    const char *s = lisp_to_string(interp, CAR(args));
+    printf("%s", s);
+    free((void*)s);
+    return NIL;
+}
+
+SExpRef builtin_print(Interp *interp, SExpRef args) {
     if (LENGTH(args) != 1) {
         return new_error(interp, "show wrong argument number.\n");
     }
diff --git a/src/builtins.h b/src/builtins.h
index 8f9c428..8568a92 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -3,6 +3,9 @@
 
 #include "interp.h"
 
+SExpRef builtin_format(Interp *interp, SExpRef sexp);
+SExpRef builtin_concat(Interp *interp, SExpRef sexp);
+SExpRef builtin_print(Interp *interp, SExpRef sexp);
 SExpRef builtin_exit(Interp *interp, SExpRef sexp);
 SExpRef builtin_error(Interp *interp, SExpRef sexp);
 SExpRef builtin_list(Interp *interp, SExpRef sexp);
@@ -22,7 +25,7 @@ SExpRef builtin_gt(Interp *interp, SExpRef sexp);
 SExpRef builtin_lt(Interp *interp, SExpRef sexp);
 SExpRef builtin_ge(Interp *interp, SExpRef sexp);
 SExpRef builtin_le(Interp *interp, SExpRef sexp);
-SExpRef builtin_show(Interp *interp, SExpRef sexp);
+SExpRef builtin_princ(Interp *interp, SExpRef sexp);
 SExpRef builtin_gcstat(Interp *interp, SExpRef sexp);
 
 #endif
diff --git a/src/interp.c b/src/interp.c
index 5893ccc..a99440c 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -86,8 +86,11 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "assert-error", primitive_assert_error);
     Interp_add_primitive(self, "load", primitive_load);
 
+    Interp_add_userfunc(self, "format", builtin_format);
+    Interp_add_userfunc(self, "concat", builtin_concat);
     Interp_add_userfunc(self, "error", builtin_error);
-    Interp_add_userfunc(self, "show", builtin_show);
+    Interp_add_userfunc(self, "print", builtin_print);
+    Interp_add_userfunc(self, "princ", builtin_princ);
     Interp_add_userfunc(self, "car", builtin_car);
     Interp_add_userfunc(self, "list", builtin_list);
     Interp_add_userfunc(self, "cdr", builtin_cdr);
@@ -603,7 +606,7 @@ SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
             } else {
                 ret = EVAL(exp);
             }
-            if (CTL_FL(exp)) goto end;
+            if (CTL_FL(ret)) goto end;
             iter = CDR(iter);
         }
     } else if (VALTYPE(fn) == kUserFuncSExp) {
diff --git a/src/primitives.c b/src/primitives.c
index 87c266e..ca04f84 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -14,13 +14,16 @@ SExpRef primitive_load(Interp *interp, SExpRef args, bool istail) {
         return new_error(interp, "load: load can only be in top level.\n");
     }
     if (LENGTH(args) != 1) return new_error(interp, "load: syntax error.\n");
+    args = lisp_eval_args(interp, args);
     if (VALTYPE(CAR(args)) != kStringSExp) return new_error(interp, "load: syntax error.\n");
     Parser *old_parser = interp->parser;
     Parser *new_parser = malloc(sizeof(Parser));
     Parser_init(new_parser);
     new_parser->ctx = interp;
     interp->parser = new_parser;
+    PUSH_REG(args);
     SExpRef ret = Interp_load_file(interp, REF(CAR(args))->str);
+    POP_REG();
     Parser_free(new_parser);
     free(new_parser);
     interp->parser = old_parser;
@@ -354,7 +357,10 @@ SExpRef primitive_funcall(Interp *interp, SExpRef args, bool istail) {
     if (LENGTH(args) < 1) goto error;
     args = lisp_eval_args(interp, args);
     if (CTL_FL(args)) return args;
-    return lisp_apply(interp, CAR(args), CDR(args), istail);
+    PUSH_REG(args);
+    SExpRef ret = lisp_apply(interp, CAR(args), CDR(args), istail);
+    POP_REG();
+    return ret;
 error:
     return new_error(interp, "funcall: syntax error.\n");
 }