refactor; while

6 files changed, 474 insertions, 274 deletions

diff --git a/src/builtins.c b/src/builtins.c
new file mode 100644
index 0000000..ade9091
--- /dev/null
+++ b/src/builtins.c
@@ -0,0 +1,249 @@
+#include "builtins.h"
+#include "interp.h"
+#include "sexp.h"
+
+SExpRef builtin_list(Interp *interp, SExpRef args) {
+    return args;
+}
+
+SExpRef builtin_car(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 1) {
+        return new_error(interp, "car: wrong argument number.\n");
+    }
+    if (ERRORP(args)) return args;
+    return CAR(CAR(args));
+}
+
+SExpRef builtin_cdr(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 1) {
+        return new_error(interp, "cdr: wrong argument number.\n");
+    }
+    return CDR(CAR(args));
+}
+
+SExpRef builtin_cons(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 2) {
+        return new_error(interp, "cons: wrong argument number.\n");
+    }
+    return CONS(CAR(args), CADR(args));
+}
+
+static SExp raw_add(SExp a, SExp b) {
+    if (a.type == kRealSExp || b.type == kRealSExp) {
+        double result = 0;
+        if (a.type == kRealSExp) result += a.real;
+        else result += a.integer;
+        if (b.type == kRealSExp) result += b.real;
+        else result += b.integer;
+        return (SExp){ .type = kRealSExp, .real = result };
+    } else {
+        int64_t result;
+        return (SExp){ .type = kIntegerSExp, .integer= a.integer + b.integer};
+    }
+}
+
+static SExp raw_sub(SExp a, SExp b) {
+    if (a.type == kRealSExp || b.type == kRealSExp) {
+        double result = 0;
+        if (a.type == kRealSExp) result += a.real;
+        else result += a.integer;
+        if (b.type == kRealSExp) result -= b.real;
+        else result -= b.integer;
+        return (SExp){ .type = kRealSExp, .real = result };
+    } else {
+        int64_t result;
+        return (SExp){ .type = kIntegerSExp, .real = a.integer - b.integer};
+    }
+}
+
+SExpRef builtin_add(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExp acc = {.type = kIntegerSExp, .integer = 0};
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
+            return new_error(interp, "+: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    cur = args;
+    while (!NILP(cur)) {
+        acc = raw_add(acc, *REF(CAR(cur)));
+        cur = CDR(cur);
+    }
+    ret = new_sexp(interp);
+    *REF(ret) = acc;
+    return ret;
+}
+
+SExpRef builtin_sub(Interp *interp, SExpRef args) {
+    SExpRef ret;
+    SExpRef cur = args;
+    while (!NILP(cur)) {
+        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
+            return new_error(interp, "-: wrong argument type.\n");
+        }
+        cur = CDR(cur);
+    }
+    int args_len = lisp_length(interp, args);
+    if (args_len == 1) {
+        SExp num = *REF(CAR(args));
+        if (num.type == kIntegerSExp) {
+            return new_integer(interp, -num.integer);
+        }
+        return new_real(interp, -num.real);
+    }
+    if (args_len == 2) {
+        SExp num = raw_sub(*REF(CAR(args)), *REF(CADR(args)));
+        ret = new_sexp(interp);
+        *REF(ret) = num;
+        return ret;
+    }
+    return new_error(interp, "-: wrong argument number.\n");
+}
+
+SExpRef builtin_num_equal(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, "=: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, "=: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, "=: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs == frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer == REF(rhs)->integer);
+    }
+}
+
+SExpRef builtin_gt(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, ">: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, ">: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, ">: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs > frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer > REF(rhs)->integer);
+    }
+}
+
+SExpRef builtin_lt(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, "<: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, "<: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, "<: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs < frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer < REF(rhs)->integer);
+    }
+}
+
+SExpRef builtin_ge(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, ">=: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, ">=: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, ">=: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs >= frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer >= REF(rhs)->integer);
+    }
+}
+
+SExpRef builtin_le(Interp *interp, SExpRef args) {
+    int args_len = lisp_length(interp, args);
+    if (args_len != 2) return new_error(interp, "<=: wrong argument number.\n");
+    SExpRef lhs = CAR(args);
+    SExpRef rhs = CADR(args);
+    if (VALTYPE(lhs) != kRealSExp && VALTYPE(lhs) != kIntegerSExp) {
+        return new_error(interp, "<=: type error.\n");
+    }
+    if (VALTYPE(rhs) != kRealSExp && VALTYPE(rhs) != kIntegerSExp) {
+        return new_error(interp, "<=: type error.\n");
+    }
+    if (VALTYPE(lhs) == kRealSExp || VALTYPE(rhs) == kRealSExp) {
+        double flhs, frhs;
+        if (VALTYPE(lhs) == kIntegerSExp) {
+            flhs = REF(lhs)->integer;
+        } else {
+            flhs = REF(lhs)->real;
+        }
+        if (VALTYPE(rhs) == kIntegerSExp) {
+            frhs = REF(rhs)->integer;
+        } else {
+            frhs = REF(rhs)->real;
+        }
+        return new_boolean(interp, flhs <= frhs);
+    } else {
+        return new_boolean(interp, REF(lhs)->integer <= REF(rhs)->integer);
+    }
+}
+
diff --git a/src/builtins.h b/src/builtins.h
new file mode 100644
index 0000000..125a042
--- /dev/null
+++ b/src/builtins.h
@@ -0,0 +1,20 @@
+#ifndef BAMBOO_LISP_BUILTINS_H_
+#define BAMBOO_LISP_BUILTINS_H_
+
+#include "interp.h"
+
+SExpRef builtin_list(Interp *interp, SExpRef sexp);
+SExpRef builtin_car(Interp *interp, SExpRef sexp);
+SExpRef builtin_cdr(Interp *interp, SExpRef sexp);
+SExpRef builtin_cons(Interp *interp, SExpRef sexp);
+
+SExpRef builtin_add(Interp *interp, SExpRef sexp);
+SExpRef builtin_sub(Interp *interp, SExpRef sexp);
+
+SExpRef builtin_num_equal(Interp *interp, SExpRef sexp);
+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);
+
+#endif
diff --git a/src/interp.c b/src/interp.c
index 81bb4b5..016f3a4 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -7,32 +7,11 @@
 #include <algds/str.h>
 
 #include "sexp.h"
+#include "builtins.h"
+#include "primitives.h"
 
 #define BUFSIZE 1024
 
-#define REF(_x) (Interp_ref(interp, (_x)))
-#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
-#define NILP(_x) (lisp_nilp(interp, (_x)))
-#define EVAL(_x) (lisp_eval(interp, (_x)))
-#define TRUEP(_x) (lisp_truep(interp, (_x)))
-#define ERRORP(_x) (REF((_x))->type == kErrSExp)
-
-#define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); }
-#define POP_REG() { interp->reg = CDR(interp->reg);  }
-
-#define CAR(_x) (lisp_car(interp, (_x)))
-#define CDR(_x) (lisp_cdr(interp, (_x)))
-#define CADR(_x) CAR(CDR(_x))
-#define CDDR(_x) CDR(CDR(_x))
-#define CADDR(_x) CAR(CDDR(_x))
-#define CDDDR(_x) CDR(CDDR(_x))
-#define CADDDR(_x) CAR(CDDDR(_x))
-#define CDDDDR(_x) CDR(CDDDR(_x))
-#define CADDDDR(_x) CAR(CDDDDR(_x))
-#define CDDDDDR(_x) CDR(CDDDDR(_x))
-
-#define NIL (interp->nil)
-
 void PrimitiveEntry_show(PrimitiveEntry self, FILE *fp) { }
 VECTOR_IMPL(PrimitiveEntry);
 
@@ -53,7 +32,7 @@ void Interp_init(Interp *self) {
     SExpVector_push_back(&self->objs, sexp);
     self->top_level = (SExpRef){1};
     sexp.type = kEmptySExp;
-    for (int i = 1; i < 1024; i++) {
+    for (int i = 2; i < 1024; i++) {
         SExpVector_push_back(&self->objs, sexp);
         IntVector_push_back(&self->empty_space, i);
     }
@@ -66,18 +45,24 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "progn", primitive_progn);
     Interp_add_primitive(self, "setq", primitive_setq);
     Interp_add_primitive(self, "let", primitive_let);
+    Interp_add_primitive(self, "while", primitive_while);
 
-    Interp_add_userfunc(self, "car", userfunc_car);
-    Interp_add_userfunc(self, "list", userfunc_list);
-    Interp_add_userfunc(self, "cdr", userfunc_cdr);
-    Interp_add_userfunc(self, "cons", userfunc_cons);
-    Interp_add_userfunc(self, "+", userfunc_add);
-    Interp_add_userfunc(self, "-", userfunc_sub);
+    Interp_add_userfunc(self, "car", builtin_car);
+    Interp_add_userfunc(self, "list", builtin_list);
+    Interp_add_userfunc(self, "cdr", builtin_cdr);
+    Interp_add_userfunc(self, "cons", builtin_cons);
+    Interp_add_userfunc(self, "+", builtin_add);
+    Interp_add_userfunc(self, "-", builtin_sub);
+    Interp_add_userfunc(self, "=", builtin_num_equal);
+    Interp_add_userfunc(self, "<", builtin_lt);
+    Interp_add_userfunc(self, ">", builtin_gt);
+    Interp_add_userfunc(self, ">=", builtin_ge);
+    Interp_add_userfunc(self, "<=", builtin_le);
 }
 
 void Interp_add_userfunc(Interp *interp, const char *name, LispUserFunc fn) {
     SExpRef userfunc = new_userfunc(interp, fn);
-    lisp_defun(interp, name, userfunc);
+    lisp_setfun(interp, name, userfunc);
 }
 
 void Interp_free(Interp *self) {
@@ -226,7 +211,7 @@ const char* lisp_to_string(Interp *interp, SExpRef val) {
     return sb.buf;
 }
 
-void lisp_defun(Interp *interp, const char *name, SExpRef val) {
+void lisp_setfun(Interp *interp, const char *name, SExpRef val) {
     SExpRef binding = REF(interp->top_level)->env.bindings;
     while (REF(binding)->type != kNilSExp) {
         if (strcmp(name, REF(REF(binding)->binding.name)->str) == 0) {
@@ -334,232 +319,6 @@ int lisp_length(Interp *interp, SExpRef lst) {
     return cnt;
 }
 
-SExpRef userfunc_list(Interp *interp, SExpRef args) {
-    return args;
-}
-
-SExpRef userfunc_car(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) != 1) {
-        return new_error(interp, "car: wrong argument number.\n");
-    }
-    if (ERRORP(args)) return args;
-    return CAR(CAR(args));
-}
-
-SExpRef userfunc_cdr(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) != 1) {
-        return new_error(interp, "cdr: wrong argument number.\n");
-    }
-    return CDR(CAR(args));
-}
-
-SExpRef userfunc_cons(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) != 2) {
-        return new_error(interp, "cons: wrong argument number.\n");
-    }
-    return CONS(CAR(args), CADR(args));
-}
-
-static SExp raw_add(SExp a, SExp b) {
-    if (a.type == kRealSExp || b.type == kRealSExp) {
-        double result = 0;
-        if (a.type == kRealSExp) result += a.real;
-        else result += a.integer;
-        if (b.type == kRealSExp) result += b.real;
-        else result += b.integer;
-        return (SExp){ .type = kRealSExp, .real = result };
-    } else {
-        int64_t result;
-        return (SExp){ .type = kIntegerSExp, .integer= a.integer + b.integer};
-    }
-}
-
-static SExp raw_sub(SExp a, SExp b) {
-    if (a.type == kRealSExp || b.type == kRealSExp) {
-        double result = 0;
-        if (a.type == kRealSExp) result += a.real;
-        else result += a.integer;
-        if (b.type == kRealSExp) result -= b.real;
-        else result -= b.integer;
-        return (SExp){ .type = kRealSExp, .real = result };
-    } else {
-        int64_t result;
-        return (SExp){ .type = kIntegerSExp, .real = a.integer - b.integer};
-    }
-}
-
-SExpRef userfunc_add(Interp *interp, SExpRef args) {
-    SExpRef ret;
-    SExp acc = {.type = kIntegerSExp, .integer = 0};
-    SExpRef cur = args;
-    while (!NILP(cur)) {
-        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
-            return new_error(interp, "+: wrong argument type.\n");
-        }
-        cur = CDR(cur);
-    }
-    cur = args;
-    while (!NILP(cur)) {
-        acc = raw_add(acc, *REF(CAR(cur)));
-        cur = CDR(cur);
-    }
-    ret = new_sexp(interp);
-    *REF(ret) = acc;
-    return ret;
-}
-
-SExpRef userfunc_sub(Interp *interp, SExpRef args) {
-    SExpRef ret;
-    SExpRef cur = args;
-    while (!NILP(cur)) {
-        if (REF(CAR(cur))->type != kIntegerSExp && REF(CAR(cur))->type != kRealSExp) {
-            return new_error(interp, "-: wrong argument type.\n");
-        }
-        cur = CDR(cur);
-    }
-    int args_len = lisp_length(interp, args);
-    if (args_len == 1) {
-        SExp num = *REF(CAR(args));
-        if (num.type == kIntegerSExp) {
-            return new_integer(interp, -num.integer);
-        }
-        return new_real(interp, -num.real);
-    }
-    if (args_len == 2) {
-        SExp num = raw_sub(*REF(CAR(args)), *REF(CADR(args)));
-        ret = new_sexp(interp);
-        *REF(ret) = num;
-        return ret;
-    }
-    return new_error(interp, "-: wrong argument number.\n");
-}
-
-// TODO:
-// - while
-// - lambda
-// - defun
-// - funcall
-// - apply
-// - defvar
-// - defmacro
-// - macroexpand-1
-
-SExpRef primitive_if(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) != 3) goto error;
-    SExpRef cond = CAR(args);
-    SExpRef tb = CADR(args);
-    SExpRef fb = CADDR(args);
-    cond = EVAL(cond);
-    if (ERRORP(cond)) return cond;
-    if (TRUEP(cond)) return EVAL(tb);
-    else return EVAL(fb);
-    return NIL;
-error:
-    return new_error(interp, "if: syntax error.\n");
-}
-
-SExpRef primitive_cond(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) < 1) goto error;
-    SExpRef iter = args;
-    while (!NILP(iter)) {
-        SExpRef pair = CAR(iter);
-        if (!lisp_check_list(interp, pair)) goto error;
-        if (lisp_length(interp, pair) != 2) goto error;
-        SExpRef condition = CAR(pair);
-        SExpRef exp = CADR(pair);
-        condition = EVAL(condition);
-        if (ERRORP(condition)) return condition;
-        if (TRUEP(condition)) return EVAL(exp);
-        iter = CDR(iter);
-    }
-    return NIL;
-error:
-    return new_error(interp, "cond: syntax error.\n");
-}
-
-SExpRef primitive_progn(Interp *interp, SExpRef args) {
-    SExpRef iter = args;
-    SExpRef ret;
-    while (!NILP(iter)) {
-        ret = EVAL(CAR(iter));
-        if (ERRORP(ret)) return ret;
-        iter = CDR(iter);
-    }
-    return ret;
-}
-
-SExpRef primitive_setq(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) != 2) goto error;
-    SExpRef name = CAR(args);
-    SExpRef exp = CADR(args);
-    if (REF(name)->type != kSymbolSExp) goto error;
-    SExpRef value = EVAL(exp);
-    if (ERRORP(value)) return value;
-    lisp_setq(interp, REF(name)->str, value);
-    return NIL;
-error:
-    return new_error(interp, "setq: syntax error.\n");
-}
-
-static const char *binding_name(Interp *interp, SExpRef binding) {
-    SExpRef namesym = REF(binding)->binding.name;
-    return REF(namesym)->str;
-}
-
-static bool is_binding_repeat(Interp *interp, SExpRef sym, SExpRef env) {
-    SExpRef binding = REF(env)->env.bindings;
-    while (!NILP(binding)) {
-        if (strcmp(REF(sym)->str, binding_name(interp, binding)) == 0) return true;
-        binding = REF(binding)->binding.next;
-    }
-    return false;
-}
-
-SExpRef primitive_let(Interp *interp, SExpRef args) {
-    if (lisp_length(interp, args) < 1) goto error;
-    SExpRef bindings = CAR(args);
-    SExpRef env = new_env(interp);
-    REF(env)->env.parent = CAR(interp->stack);
-
-    SExpRef iter = bindings;
-    while (!NILP(iter)) {
-        SExpRef x = CAR(iter);
-        if (!lisp_check_list(interp, x)) goto error;
-        if (lisp_length(interp, x) != 2) goto error;
-        if (REF(CAR(x))->type != kSymbolSExp) goto error;
-        if (is_binding_repeat(interp, CAR(x), env)) goto error;
-        SExpRef binding = new_binding(interp, CAR(x), NIL);
-        REF(binding)->binding.next = REF(env)->env.bindings;
-        REF(env)->env.bindings = binding;
-        iter = CDR(iter);
-    }
-    interp->stack = CONS(env, interp->stack);
-
-    iter = bindings;
-    while (!NILP(iter)) {
-        SExpRef x = CAR(iter);
-        SExpRef val = EVAL(CADR(x));
-        if (REF(val)->type == kErrSExp) goto end;
-        lisp_setq(interp, REF(CAR(x))->str, val);
-        iter = CDR(iter);
-    }
-
-    SExpRef body = CDR(args);
-    SExpRef ret = NIL;
-    iter = body;
-    while (!NILP(iter)) {
-        SExpRef exp = CAR(iter);
-        ret = EVAL(exp);
-        if (REF(ret)->type == kErrSExp) goto end;
-        iter = CDR(iter);
-    }
-end:
-    interp->stack = CDR(interp->stack);
-    return ret;
-
-error:
-    return new_error(interp, "let: syntax error. \n");
-}
 
 SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
     SExpRef ret;
diff --git a/src/interp.h b/src/interp.h
index 221eb19..15a8851 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -8,7 +8,6 @@
 #include "algds/vec.h"
 #include "sexp.h"
 
-
 struct interp;
 typedef struct interp Interp;
 
@@ -33,7 +32,6 @@ struct interp {
     char *errmsg_buf;
 };
 
-
 void Interp_init(Interp *self);
 void Interp_free(Interp *self);
 SExp* Interp_ref(Interp *self, SExpRef ref);
@@ -41,26 +39,38 @@ void Interp_gc(Interp *self, SExpRef tmp_root);
 void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
 void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
 
-SExpRef primitive_if(Interp *interp, SExpRef sexp);
-SExpRef primitive_cond(Interp *interp, SExpRef sexp);
-SExpRef primitive_progn(Interp *interp, SExpRef sexp);
-SExpRef primitive_setq(Interp *interp, SExpRef sexp);
-SExpRef primitive_let(Interp *interp, SExpRef sexp);
-
-SExpRef userfunc_list(Interp *interp, SExpRef sexp);
-SExpRef userfunc_car(Interp *interp, SExpRef sexp);
-SExpRef userfunc_cdr(Interp *interp, SExpRef sexp);
-SExpRef userfunc_cons(Interp *interp, SExpRef sexp);
-SExpRef userfunc_add(Interp *interp, SExpRef sexp);
-SExpRef userfunc_sub(Interp *interp, SExpRef sexp);
-
-void lisp_defun(Interp *interp, const char *name, SExpRef val);
+#define REF(_x) (Interp_ref(interp, (_x)))
+#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
+#define NILP(_x) (lisp_nilp(interp, (_x)))
+#define EVAL(_x) (lisp_eval(interp, (_x)))
+#define TRUEP(_x) (lisp_truep(interp, (_x)))
+#define ERRORP(_x) (REF((_x))->type == kErrSExp)
+#define VALTYPE(_x) (REF((_x))->type)
+#define NIL (interp->nil)
+#define CAR(_x) (lisp_car(interp, (_x)))
+#define CDR(_x) (lisp_cdr(interp, (_x)))
+#define CADR(_x) CAR(CDR(_x))
+#define CDDR(_x) CDR(CDR(_x))
+#define CADDR(_x) CAR(CDDR(_x))
+#define CDDDR(_x) CDR(CDDR(_x))
+#define CADDDR(_x) CAR(CDDDR(_x))
+#define CDDDDR(_x) CDR(CDDDR(_x))
+#define CADDDDR(_x) CAR(CDDDDR(_x))
+#define CDDDDDR(_x) CDR(CDDDDR(_x))
+#define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); }
+#define POP_REG() { interp->reg = CDR(interp->reg);  }
+
+void lisp_setfun(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_cons(Interp *interp, SExpRef a, SExpRef b);
 SExpRef lisp_dup(Interp *interp, SExpRef arg);
 bool lisp_nilp(Interp *interp, SExpRef arg);
+bool lisp_truep(Interp *interp, SExpRef a);
+bool lisp_check_list(Interp *interp, SExpRef lst);
+SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val);
+int lisp_length(Interp *interp, SExpRef lst);
 SExpRef lisp_car(Interp *interp, SExpRef arg);
 SExpRef lisp_cdr(Interp *interp, SExpRef arg);
 SExpRef lisp_eval(Interp *interp, SExpRef arg);
diff --git a/src/primitives.c b/src/primitives.c
new file mode 100644
index 0000000..9554fb6
--- /dev/null
+++ b/src/primitives.c
@@ -0,0 +1,149 @@
+#include "primitives.h"
+#include "sexp.h"
+
+SExpRef primitive_if(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 3) goto error;
+    SExpRef cond = CAR(args);
+    SExpRef tb = CADR(args);
+    SExpRef fb = CADDR(args);
+    cond = EVAL(cond);
+    if (ERRORP(cond)) return cond;
+    if (TRUEP(cond)) return EVAL(tb);
+    else return EVAL(fb);
+    return NIL;
+error:
+    return new_error(interp, "if: syntax error.\n");
+}
+
+SExpRef primitive_cond(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) goto error;
+    SExpRef iter = args;
+    while (!NILP(iter)) {
+        SExpRef pair = CAR(iter);
+        if (!lisp_check_list(interp, pair)) goto error;
+        if (lisp_length(interp, pair) != 2) goto error;
+        SExpRef condition = CAR(pair);
+        SExpRef exp = CADR(pair);
+        condition = EVAL(condition);
+        if (ERRORP(condition)) return condition;
+        if (TRUEP(condition)) return EVAL(exp);
+        iter = CDR(iter);
+    }
+    return NIL;
+error:
+    return new_error(interp, "cond: syntax error.\n");
+}
+
+SExpRef primitive_progn(Interp *interp, SExpRef args) {
+    SExpRef iter = args;
+    SExpRef ret;
+    while (!NILP(iter)) {
+        ret = EVAL(CAR(iter));
+        if (ERRORP(ret)) return ret;
+        iter = CDR(iter);
+    }
+    return ret;
+}
+
+SExpRef primitive_setq(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 2) goto error;
+    SExpRef name = CAR(args);
+    SExpRef exp = CADR(args);
+    if (REF(name)->type != kSymbolSExp) goto error;
+    SExpRef value = EVAL(exp);
+    if (ERRORP(value)) return value;
+    return lisp_setq(interp, REF(name)->str, value);
+error:
+    return new_error(interp, "setq: syntax error.\n");
+}
+
+static const char *binding_name(Interp *interp, SExpRef binding) {
+    SExpRef namesym = REF(binding)->binding.name;
+    return REF(namesym)->str;
+}
+
+static bool is_binding_repeat(Interp *interp, SExpRef sym, SExpRef env) {
+    SExpRef binding = REF(env)->env.bindings;
+    while (!NILP(binding)) {
+        if (strcmp(REF(sym)->str, binding_name(interp, binding)) == 0) return true;
+        binding = REF(binding)->binding.next;
+    }
+    return false;
+}
+
+SExpRef primitive_let(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 1) goto error;
+    SExpRef bindings = CAR(args);
+    SExpRef env = new_env(interp);
+    REF(env)->env.parent = CAR(interp->stack);
+
+    SExpRef iter = bindings;
+    while (!NILP(iter)) {
+        SExpRef x = CAR(iter);
+        if (!lisp_check_list(interp, x)) goto error;
+        if (lisp_length(interp, x) != 2) goto error;
+        if (REF(CAR(x))->type != kSymbolSExp) goto error;
+        if (is_binding_repeat(interp, CAR(x), env)) goto error;
+        SExpRef binding = new_binding(interp, CAR(x), NIL);
+        REF(binding)->binding.next = REF(env)->env.bindings;
+        REF(env)->env.bindings = binding;
+        iter = CDR(iter);
+    }
+    interp->stack = CONS(env, interp->stack);
+
+    SExpRef ret = NIL;
+    iter = bindings;
+    while (!NILP(iter)) {
+        SExpRef x = CAR(iter);
+        SExpRef val = EVAL(CADR(x));
+        if (REF(val)->type == kErrSExp) goto end;
+        ret = lisp_setq(interp, REF(CAR(x))->str, val);
+        if (ERRORP(ret)) goto end;
+        iter = CDR(iter);
+    }
+
+    SExpRef body = CDR(args);
+    iter = body;
+    while (!NILP(iter)) {
+        SExpRef exp = CAR(iter);
+        ret = EVAL(exp);
+        if (REF(ret)->type == kErrSExp) goto end;
+        iter = CDR(iter);
+    }
+end:
+    interp->stack = CDR(interp->stack);
+    return ret;
+
+error:
+    return new_error(interp, "let: syntax error. \n");
+}
+
+SExpRef primitive_while(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) < 2) goto error;
+    SExpRef ret = NIL;
+    SExpRef pred = CAR(args);
+    SExpRef body = CDR(args);
+    while (1) {
+        SExpRef cond = EVAL(pred);
+        if (ERRORP(cond)) return cond;
+        if (!TRUEP(cond)) return ret;
+        SExpRef iter = body;
+        while (!NILP(iter)) {
+            SExpRef x = CAR(iter);
+            ret = EVAL(x);
+            if (ERRORP(ret)) return ret;
+            iter = CDR(iter);
+        }
+    }
+error:
+    return new_error(interp, "while: syntax error.\n");
+}
+// TODO:
+// - while
+// - lambda
+// - defun
+// - funcall
+// - apply
+// - defvar
+// - defmacro
+// - macroexpand-1
diff --git a/src/primitives.h b/src/primitives.h
new file mode 100644
index 0000000..1bfe710
--- /dev/null
+++ b/src/primitives.h
@@ -0,0 +1,13 @@
+#ifndef BAMBOO_LISP_PRIMITIVIE_H_
+#define BAMBOO_LISP_PRIMITIVIE_H_
+
+#include "interp.h"
+
+SExpRef primitive_if(Interp *interp, SExpRef sexp);
+SExpRef primitive_cond(Interp *interp, SExpRef sexp);
+SExpRef primitive_progn(Interp *interp, SExpRef sexp);
+SExpRef primitive_setq(Interp *interp, SExpRef sexp);
+SExpRef primitive_let(Interp *interp, SExpRef sexp);
+SExpRef primitive_while(Interp *interp, SExpRef sexp);
+
+#endif