finish function

8 files changed, 148 insertions, 18 deletions

diff --git a/src/builtins.c b/src/builtins.c
index ade9091..2ad3916 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -14,6 +14,14 @@ SExpRef builtin_car(Interp *interp, SExpRef args) {
     return CAR(CAR(args));
 }
 
+SExpRef builtin_show(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 1) {
+        return new_error(interp, "show wrong argument number.\n");
+    }
+    lisp_print(interp, CAR(args), stdout);
+    return NIL;
+}
+
 SExpRef builtin_cdr(Interp *interp, SExpRef args) {
     if (lisp_length(interp, args) != 1) {
         return new_error(interp, "cdr: wrong argument number.\n");
@@ -51,8 +59,7 @@ static SExp raw_sub(SExp a, SExp b) {
         else result -= b.integer;
         return (SExp){ .type = kRealSExp, .real = result };
     } else {
-        int64_t result;
-        return (SExp){ .type = kIntegerSExp, .real = a.integer - b.integer};
+        return (SExp){ .type = kIntegerSExp, .integer= a.integer - b.integer};
     }
 }
 
diff --git a/src/builtins.h b/src/builtins.h
index 125a042..d4fcaf5 100644
--- a/src/builtins.h
+++ b/src/builtins.h
@@ -16,5 +16,6 @@ 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);
 
 #endif
diff --git a/src/interp.c b/src/interp.c
index dbc2357..f03a688 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -52,7 +52,12 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "function", primitive_function);
     Interp_add_primitive(self, "defun", primitive_defun);
     Interp_add_primitive(self, "defvar", primitive_defvar);
+    Interp_add_primitive(self, "funcall", primitive_funcall);
+    Interp_add_primitive(self, "apply", primitive_apply);
+    Interp_add_primitive(self, "quote", primitive_quote);
 
+    Interp_add_userfunc(self, "eval", lisp_eval);
+    Interp_add_userfunc(self, "show", builtin_show);
     Interp_add_userfunc(self, "car", builtin_car);
     Interp_add_userfunc(self, "list", builtin_list);
     Interp_add_userfunc(self, "cdr", builtin_cdr);
@@ -167,6 +172,8 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
         str_builder_append(sb, "\"%s\"", pe->str);
     } else if (pe->type == kFuncSExp) {
         str_builder_append(sb, "<FUNCTION>");
+    } else if (pe->type == kUserFuncSExp) {
+        str_builder_append(sb, "<FUNCTION>");
     } else if (pe->type == kMacroSExp) {
         str_builder_append(sb, "<MACRO>");
     } else if (pe->type == kEnvSExp) {
@@ -192,15 +199,12 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
             }
             if (REF(cur)->type == kNilSExp) {
                 sb->buf[sb->size - 1] = ')';
-                str_builder_append_char(sb, '\0');
             } else if (REF(cur)->type != kPairSExp) {
                 str_builder_append(sb, ". ");
                 lisp_to_string_impl(sb, visited, interp, cur);
                 str_builder_append(sb, ")");
-                str_builder_append_char(sb, '\0');
             } else {
                 str_builder_append(sb, "<%d>)", cur.idx);
-                str_builder_append_char(sb, '\0');
             }
         }
     }
@@ -213,6 +217,7 @@ const char* lisp_to_string(Interp *interp, SExpRef val) {
     Int2IntHashTable_init(&visited);
     init_str_builder(&sb);
     lisp_to_string_impl(&sb, &visited, interp, val);    
+    str_builder_append_char(&sb, '\0');
     Int2IntHashTable_free(&visited);
     return sb.buf;
 }
@@ -229,6 +234,7 @@ void lisp_defun(Interp *interp, const char *name, SExpRef val) {
     binding = REF(interp->top_level)->env.bindings;
     SExpRef newbinding = new_binding(interp, new_symbol(interp, name), NIL);
     REF(newbinding)->binding.func = val;
+    REF(newbinding)->binding.value = unbound;
     REF(newbinding)->binding.next = binding;
     REF(interp->top_level)->env.bindings = newbinding;
 }
@@ -294,10 +300,13 @@ SExpRef lisp_lookup_func(Interp *interp, const char *name) {
     SExpRef binding = REF(interp->top_level)->env.bindings;
     while (REF(binding)->type != kNilSExp) {
         if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
-            return REF(binding)->binding.func;
+            SExpRef ret = REF(binding)->binding.func;
+            if (ret.idx < 0) goto notfound;
+            return ret;
         }
         binding = REF(binding)->binding.next;
     }
+notfound:
     return new_error(interp, "Unbound function: %s.\n", name);
 }
 
@@ -345,6 +354,62 @@ int lisp_length(Interp *interp, SExpRef lst) {
     return cnt;
 }
 
+static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
+    SExpRef param = REF(func)->func.args;
+    SExpRef iparam = param;
+    SExpRef iargs = args;
+    SExpRef env = new_env(interp);
+    REF(env)->env.parent = REF(func)->func.env;
+    while (!NILP(iparam)) {
+        if (VALTYPE(iparam) == kSymbolSExp) {
+            SExpRef binding = new_binding(interp, iparam, iargs);
+            REF(binding)->binding.next = REF(env)->env.bindings;
+            REF(env)->env.bindings = binding;
+            return env;
+        }
+        SExpRef name = CAR(iparam);
+        if (VALTYPE(name) != kSymbolSExp) {
+            return new_error(interp, "function syntax error: parameter must be a symbol.\n");
+        }
+        if (NILP(iargs)) return new_error(interp, "funcall: wrong argument number.\n");
+        SExpRef binding = new_binding(interp, name, CAR(iargs));
+        REF(binding)->binding.next = REF(env)->env.bindings;
+        REF(env)->env.bindings = binding;
+        iargs = CDR(iargs);
+        iparam = CDR(iparam);
+    }
+    if (!NILP(iargs)) return new_error(interp, "funcall: wrong argument number.\n");
+    return env;
+}
+
+SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args) {
+    if (VALTYPE(fn) == kFuncSExp) {
+        SExpRef env = build_function_env(interp, fn, args);
+        if (ERRORP(env)) return env;
+        interp->stack = CONS(env, interp->stack);
+        SExpRef ret;
+        SExpRef iter = REF(fn)->func.body;
+        while (!NILP(iter)) {
+            SExpRef exp = CAR(iter);
+            ret = EVAL(exp);
+            if (ERRORP(exp)) goto end;
+            iter = CDR(iter);
+        }
+        end:
+            interp->stack = CDR(interp->stack);
+            return ret;
+    } else if (VALTYPE(fn) == kUserFuncSExp) {
+        PUSH_REG(args);
+        LispUserFunc fnptr = REF(fn)->userfunc;
+        SExpRef ret = (*fnptr)(interp, args);
+        POP_REG();
+        return ret;
+    }
+error:
+    return new_error(interp, "function call: syntax error.\n");
+}
+
+
 
 SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
     SExpRef ret;
@@ -361,6 +426,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
             || type == kCharSExp
             || type == kErrSExp
             || type == kFuncSExp
+            || type == kUserFuncSExp
             || type == kRealSExp) {
         ret = sexp;
         goto end;
@@ -388,19 +454,16 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
             }
         }
         SExpRef fn = lisp_lookup_func(interp, symbol);
-        if (REF(fn)->type == kUserFuncSExp) {
-            SExpRef args = lisp_eval_args(interp, CDR(sexp));
-            if (ERRORP(args)) { ret = args; goto end; }
-            PUSH_REG(args);
-            ret = (*REF(fn)->userfunc)(interp, args);
-            POP_REG();
+        if (!ERRORP(fn)) {
+            SExpRef args = CDR(sexp);
+            ret = primitive_funcall(interp, CONS(fn, args));
             goto end;
         }
         // TODO: macro / func
         ret = new_error(interp, "eval: \"%s\" is not a primitive, function, or macro.\n", symbol);
         goto end;
     }
-    ret = NIL;
+    ret = new_error(interp, "eval: unknown syntax.\n");
 end:
     POP_REG();
     Interp_gc(interp, ret);
diff --git a/src/interp.h b/src/interp.h
index e8b3980..ae4c451 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -65,6 +65,7 @@ void lisp_defvar(Interp *interp, const char *name, SExpRef val);
 void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
 SExpRef lisp_lookup(Interp *interp, const char *name);
 SExpRef lisp_lookup_func(Interp *interp, const char *name);
+SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args);
 SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b);
 SExpRef lisp_dup(Interp *interp, SExpRef arg);
 bool lisp_nilp(Interp *interp, SExpRef arg);
diff --git a/src/main.c b/src/main.c
index 4fdb5b0..6656296 100644
--- a/src/main.c
+++ b/src/main.c
@@ -17,6 +17,8 @@ int main() {
         if (parse_result.errmsg != NULL) {
             if (Parser_peek(&parser) == EOF) goto end;
             fprintf(stderr, "Parsing error: %s", parse_result.errmsg);
+            free((void*)parser.string);
+            Parser_set_readline(&parser);
             continue;
         }
 
diff --git a/src/parser.c b/src/parser.c
index 46a94b5..45aeba6 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -140,6 +140,10 @@ ParseResult parse_sexp(Parser *parser) {
         return ParseErr(parser, "Unexpected EOF.\n");
     }
     int next = Parser_peek(parser);
+    if (next == ')') {
+        Parser_getchar(parser);
+        return ParseErr(parser, "Invalid S-Expression.\n");
+    }
     if (next == '(') {
         return parse_list(parser);
     } else if (next == ',') {
@@ -335,7 +339,7 @@ static ParseResult parse_token(Parser *parser, const char *token) {
     if (endptr == token + len) return ParseOk(new_integer(parser->ctx, integer));
     double real = strtod(token, &endptr);
     if (endptr == token + len) return ParseOk(new_real(parser->ctx, real));
-    return ParseErr(parser, "Not a number : %s\n.", token);
+    return ParseErr(parser, "Not a number : %s.\n", token);
 }
 
 ParseResult parse_string(Parser *parser) {
@@ -345,7 +349,7 @@ ParseResult parse_string(Parser *parser) {
     Parser_getchar(parser);
     while (Parser_peek(parser) != '"') {
         if (Parser_peek(parser) == EOF) {
-            return ParseErr(parser, "Unexpected EOF.\n.");
+            return ParseErr(parser, "Unexpected EOF.\n");
         }
         if (Parser_peek(parser) == '\0') {
             ret = ParseErr(parser, "Unexpected zero terminator.\n");
diff --git a/src/primitives.c b/src/primitives.c
index 25be771..2a28677 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -1,4 +1,5 @@
 #include "primitives.h"
+#include "interp.h"
 #include "sexp.h"
 
 SExpRef primitive_if(Interp *interp, SExpRef args) {
@@ -189,9 +190,57 @@ error:
     return new_error(interp, "function: syntax error.\n");
 }
 
+static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
+    SExpRef param = REF(func)->func.args;
+    SExpRef iparam = param;
+    SExpRef iargs = args;
+    SExpRef env = new_env(interp);
+    while (!NILP(iparam)) {
+        if (VALTYPE(iparam) == kSymbolSExp) {
+            SExpRef binding = new_binding(interp, iparam, iargs);
+            REF(binding)->binding.next = REF(env)->env.bindings;
+            REF(env)->env.bindings = binding;
+            return env;
+        }
+        SExpRef name = CAR(iparam);
+        if (VALTYPE(name) != kSymbolSExp) {
+            return new_error(interp, "function syntax error: parameter must be a symbol.\n");
+        }
+        if (NILP(iargs)) return new_error(interp, "funcall: wrong argument number.\n");
+        SExpRef binding = new_binding(interp, name, CAR(iargs));
+        REF(binding)->binding.next = REF(env)->env.bindings;
+        REF(env)->env.bindings = binding;
+        iargs = CDR(iargs);
+        iparam = CDR(iparam);
+    }
+    if (!NILP(iargs)) return new_error(interp, "funcall: wrong argument number.\n");
+    return env;
+}
+
+SExpRef primitive_funcall(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) goto error;
+    args = lisp_eval_args(interp, args);
+    if (ERRORP(args)) return args;
+    return lisp_apply(interp, CAR(args), CDR(args));
+error:
+    return new_error(interp, "funcall: syntax error.\n");
+}
+
+SExpRef primitive_quote(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 1) return new_error(interp, "quote: syntax error.\n");
+    return CAR(args);
+}
+
+SExpRef primitive_apply(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 2) goto error;
+    args = lisp_eval_args(interp, args);
+    if (ERRORP(args)) return args;
+    if (!lisp_check_list(interp, CADR(args))) goto error;
+    return lisp_apply(interp, CAR(args), CADR(args));
+error:
+    return new_error(interp, "apply: syntax error.\n");
+}
+
 // TODO:
-// - funcall
-// - apply
-// - defvar
 // - defmacro
 // - macroexpand-1
diff --git a/src/primitives.h b/src/primitives.h
index dfd8d2e..010c479 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -13,5 +13,8 @@ SExpRef primitive_lambda(Interp *interp, SExpRef sexp);
 SExpRef primitive_defun(Interp *interp, SExpRef sexp);
 SExpRef primitive_defvar(Interp *interp, SExpRef sexp);
 SExpRef primitive_function(Interp *interp, SExpRef sexp);
+SExpRef primitive_funcall(Interp *interp, SExpRef sexp);
+SExpRef primitive_apply(Interp *interp, SExpRef sexp);
+SExpRef primitive_quote(Interp *interp, SExpRef sexp);
 
 #endif