add format

8 files changed, 128 insertions, 11 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");
 }
diff --git a/tests/lisp/arithmetic.lisp b/tests/lisp/arithmetic.lisp
index 658bcda..2764b10 100644
--- a/tests/lisp/arithmetic.lisp
+++ b/tests/lisp/arithmetic.lisp
@@ -9,3 +9,4 @@
 (assert-error (- 1 "a"))
 (assert-error (* 1 "a"))
 (assert-error (/ 1 "a"))
+
diff --git a/tests/lisp/comment.lisp b/tests/lisp/comment.lisp
index d84a2f7..40d5081 100644
--- a/tests/lisp/comment.lisp
+++ b/tests/lisp/comment.lisp
@@ -5,3 +5,4 @@
 ;; comment
       2 3)
 ;; comment
+
diff --git a/tests/lisp/control-flow.lisp b/tests/lisp/control-flow.lisp
index 5d7290d..75095ec 100644
--- a/tests/lisp/control-flow.lisp
+++ b/tests/lisp/control-flow.lisp
@@ -1,5 +1,7 @@
 (assert-error (if (error "") 1 2))
 
+(defmacro inmacro x (progn ,@x))
+
 (let ((i 0))
   (while #t
     (if (> i 4)
@@ -28,6 +30,7 @@
 (assert-error (funcall (lambda () (break))))
 (assert-error (funcall (lambda () (continue))))
 (assert (= 1 (funcall (lambda () (return 1)))))
+(assert (= 1 (funcall (lambda () (inmacro (return 1) (return 2))))))
 (assert (= 1 (funcall (lambda () (while #t (return 1))))))
 (assert (= 1 (funcall (lambda () (let () (return 1))))))
 (assert (= 1 (funcall (lambda () (let ((x (return 1))) (return 2))))))
diff --git a/tests/lisp/test.lisp b/tests/lisp/test.lisp
index b42cc60..07bdd5b 100644
--- a/tests/lisp/test.lisp
+++ b/tests/lisp/test.lisp
@@ -1,8 +1,14 @@
-(load "arithmetic.lisp")
-(load "control-flow.lisp")
-(load "lambda.lisp")
-(load "comment.lisp")
-(load "macro.lisp")
-(load "let-binding.lisp")
+(defmacro test-module (name)
+  `(progn
+    (princ (format "[TEST] %s\n" ,name))
+    (load (format "%s.lisp" ,name))
+    (princ (format "[PASS] %s\n" ,name))))
+
+(test-module "arithmetic")
+(test-module "control-flow")
+(test-module "lambda")
+(test-module "comment")
+(test-module "macro")
+(test-module "let-binding")
 
 (exit)