From 1de8cda84460198e764a94c1f0f106ecaf001331 Mon Sep 17 00:00:00 2001 From: Mistivia Date: Sat, 21 Jun 2025 16:58:47 +0800 Subject: add format --- src/builtins.c | 96 +++++++++++++++++++++++++++++++++++++++++++- src/builtins.h | 5 ++- src/interp.c | 7 +++- src/primitives.c | 8 +++- tests/lisp/arithmetic.lisp | 1 + tests/lisp/comment.lisp | 1 + tests/lisp/control-flow.lisp | 3 ++ tests/lisp/test.lisp | 18 ++++++--- 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 + +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) -- cgit v1.0