1. knarf
  2. zombolisp

Commits

knarf  committed 5e097c0

add arithmetic primitives, remove macros, add flag for REPL

  • Participants
  • Parent commits 750afe6
  • Branches default

Comments (0)

Files changed (2)

File lisp

Binary file modified.

File lisp.c

View file
 typedef obj_t* (*funpt_t) (obj_t*, env_t*);
 typedef char sym_t[SYM_NAME_SIZE];
 
+obj_t *fn_begin(obj_t *arg, env_t *env);
+obj_t *fn_lambda(obj_t *arg, env_t *env);
+obj_t *fn_quote(obj_t *arg, env_t *env);
+obj_t *fn_plus(obj_t *arg, env_t *env);
+obj_t *fn_mult(obj_t *arg, env_t *env);
+obj_t *fn_div(obj_t *arg, env_t *env);
+obj_t *fn_mod(obj_t *arg, env_t *env);
+obj_t *fn_eq(obj_t *arg, env_t *env);
+obj_t *fn_minus(obj_t *arg, env_t *env);
+obj_t *fn_define(obj_t *arg, env_t *env);
+obj_t *fn_if(obj_t *arg, env_t *env);
+obj_t *fn_and(obj_t *arg, env_t *env);
+obj_t *fn_or(obj_t *arg, env_t *env);
+obj_t *fn_not(obj_t *arg, env_t *env);
+obj_t *fn_print(obj_t *arg, env_t *env);
 void init(void);
 env_t *mk_env(env_t *parent);
 obj_t *env_lookup(env_t *env, obj_t *sym);
  * Builtin functions
  */
 
-#define DEFUN(f) obj_t* f (obj_t* arg, env_t* env)
 #define CAR(x) ((x)->cons.car)
 #define CDR(x) ((x)->cons.cdr)
-#define EXPORT(s, eval) (env_bind(global_env, mk_sym(#s), mk_fun(fn_##s, eval)))
-
+#define EXPORT(s, v) (env_bind(global_env, mk_sym(s), v))
 #define ERR(...)                                                        \
     do {                                                                \
         printf("err: %s() in %s:%d ", __func__, __FILE__, __LINE__);    \
     } while(0)
 
 
-DEFUN(fn_begin) {
+obj_t* fn_begin (obj_t* arg, env_t* env)
+{
     obj_t* p;
 
     for(p = arg; p != Onil && CDR(p) != Onil; p = CDR(p))
     return p == Onil ? Onil : CAR(p);
 }
 
-DEFUN(fn_lambda) {
+obj_t* fn_lambda (obj_t* arg, env_t* env)
+{
     obj_t *param, *body, *lambda;
 
     param = CAR(arg);
     return lambda;
 }
 
-DEFUN(fn_quote) {
+obj_t* fn_quote (obj_t* arg, env_t* env)
+{
     return CAR(arg);
 }
 
-DEFUN(fn_plus) {
+obj_t* fn_plus (obj_t* arg, env_t* env)
+{
     obj_t *res, *p;
     int sum = 0;
     int n = 1;
         obj_t* o = CAR(p);
 
         if(o->t != NUM)
-            ERR("plus arg %d is not numeric", n);
+            ERR("+ arg %d is not numeric", n);
 
         sum += o->num;
     }
     return res;
 }
 
-DEFUN(fn_eq) {
+obj_t* fn_mult (obj_t* arg, env_t* env)
+{
+    obj_t *res, *p;
+    int mult = 1;
+    int n = 1;
+
+    for(p = arg; p != Onil; p = CDR(p), n++) {
+        obj_t* o = CAR(p);
+
+        if(o->t != NUM)
+            ERR("* arg %d is not numeric", n);
+
+        mult *= o->num;
+    }
+
+    res = mk_obj(NUM);
+    res->num = mult;
+    return res;
+}
+
+obj_t* fn_div (obj_t* arg, env_t* env)
+{
+    obj_t *a, *b, *r;
+
+    if(CAR(arg) == Onil || CDR(arg) == Onil || CDR(CDR(arg)) != Onil)
+        ERR("/ takes 2 arg.");
+
+    a = CAR(arg), b = CAR(CDR(arg));
+
+    if(a->t != b->t || a->t != NUM)
+        return Onil;
+
+    r = mk_obj(NUM);
+    r->num = a->num / b->num;
+    return r;
+}
+
+obj_t* fn_mod (obj_t* arg, env_t* env)
+{
+    obj_t *a, *b, *r;
+
+    if(CAR(arg) == Onil || CDR(arg) == Onil || CDR(CDR(arg)) != Onil)
+        ERR("%% takes 2 arg.");
+
+    a = CAR(arg), b = CAR(CDR(arg));
+
+    if(a->t != b->t || a->t != NUM)
+        return Onil;
+
+    r = mk_obj(NUM);
+    r->num = a->num % b->num;
+    return r;
+}
+
+obj_t* fn_eq (obj_t* arg, env_t* env)
+{
     obj_t *a, *b;
 
     if(CAR(arg) == Onil || CDR(arg) == Onil || CDR(CDR(arg)) != Onil)
-        ERR("eq takes 2 arg.");
+        ERR("= takes 2 arg.");
 
     a = CAR(arg), b = CAR(CDR(arg));
 
-    if(a->t != NUM || b->t != NUM)
-        ERR("eq takes 2 num arg.");
+    if(a->t != b->t)
+        return Onil;
 
-    return a->num == b->num ? Ot : Onil;
+    switch(a->t) {
+    case FUN:
+        return a->fun.f == b->fun.f ? Ot : Onil;
+    case NUM:
+        return a->num == b->num ? Ot : Onil;
+    default:
+        return a == b ? Ot : Onil;
+    }
 }
 
-DEFUN(fn_minus) {
-    obj_t *a, *b, *r;
+obj_t* fn_minus (obj_t* arg, env_t* env)
+{
+    int first, sum = 0;
+    int n = 0;
+    obj_t *r, *p;
 
-    if(CAR(arg) == Onil || CDR(arg) == Onil || CDR(CDR(arg)) != Onil)
-        ERR("eq takes 2 arg.");
+    if(CAR(arg) == Onil || CAR(arg)->t != NUM)
+        goto err;
+    
+    first = CAR(arg)->num;
+    n = 1;
 
-    a = CAR(arg), b = CAR(CDR(arg));
+    for(p = CDR(arg); p != Onil; p = CDR(p)) {
+        if(CAR(p)->t != NUM)
+            goto err;
 
-    if(a->t != NUM || b->t != NUM)
-        ERR("eq takes 2 num arg.");
+        sum += CAR(p)->num;
+        n++;
+    }
 
     r = mk_obj(NUM);
-    r->num = a->num - b->num;
+    if(n == 1)
+        r->num = -first;
+    else
+        r->num = first - sum;
     return r;
+
+ err:
+    ERR("with one arg, negates it; with more than one arg, subtracts"
+        "all but the first from the first");
+    return Onil;
 }
 
-DEFUN(fn_define) {
+obj_t* fn_define (obj_t* arg, env_t* env)
+{
     obj_t *sym, *val;
 
     sym = CAR(arg);
     return val;
 }
 
-DEFUN(fn_if) {
+obj_t* fn_if (obj_t* arg, env_t* env)
+{
     obj_t *xcond, *xthen, *xelse;
 
     if(CDR(arg) == Onil || CDR(CDR(arg)) == Onil)
         return eval_obj(xelse, env);
 }
 
+obj_t* fn_and (obj_t* arg, env_t* env)
+{
+    obj_t* p;
+    int n = 0;
+
+    for(p = arg; p != Onil; p = CDR(arg)) {
+        if(eval_obj(CAR(p), env) == Onil)
+            return Onil;
+        n++;
+    }
+
+    if(n == 0)
+        ERR("and takes one or more parameters");
+
+    return Ot;
+}
+
+obj_t* fn_or (obj_t* arg, env_t* env)
+{
+    obj_t* p;
+    int n = 0;
+
+    for(p = arg; p != Onil; p = CDR(arg)) {
+        if(eval_obj(CAR(p), env) != Onil)
+            return Ot;
+        n++;
+    }
+
+    if(n == 0)
+        ERR("or takes one or more parameters");
+
+    return Onil;
+}
+
+obj_t* fn_not (obj_t* arg, env_t* env)
+{
+
+    if(arg == Onil || CDR(arg) != Onil)
+        ERR("not take exactly one parameters");
+
+    if(eval_obj(CAR(arg), env) != Onil)
+        return Onil;
+    else
+        return Ot;
+}
+
+obj_t* fn_print (obj_t* arg, env_t* env)
+{
+    if(arg == Onil || CDR(arg) != Onil)
+        ERR("print takes one param.");
+
+    print_obj(CAR(arg));
+    putchar('\n');
+    return Ot;
+}
+
 void init (void)
 {
     global_env = mk_env(NULL);
     Onil = mk_cons(NULL, NULL);
     Ot = mk_sym("t");
     Oquote = mk_sym("quote");
-    env_bind(global_env, mk_sym("nil"), Onil);
-    env_bind(global_env, Ot, Ot);
-    env_bind(global_env, Oquote, mk_fun(fn_quote, ARG_QUOTE));
 
-    EXPORT(plus, ARG_EVAL);
-    EXPORT(define, ARG_EVAL);
-    EXPORT(if, ARG_QUOTE);
-    EXPORT(lambda, ARG_QUOTE);
-    EXPORT(eq, ARG_EVAL);
-    EXPORT(minus, ARG_EVAL);
-    EXPORT(begin, ARG_EVAL);
+    /* nil & t */
+    EXPORT("nil", Onil);
+    EXPORT("t",   Ot);
+
+    /* special forms */
+    EXPORT("quote",  mk_fun(fn_quote,  ARG_QUOTE));
+    EXPORT("if",     mk_fun(fn_if,     ARG_QUOTE));
+    EXPORT("lambda", mk_fun(fn_lambda, ARG_QUOTE));
+    EXPORT("and",    mk_fun(fn_and,    ARG_QUOTE));
+    EXPORT("or",     mk_fun(fn_or,     ARG_QUOTE));
+    EXPORT("not",    mk_fun(fn_not,    ARG_QUOTE));
+
+    /* common functions */
+    EXPORT("define", mk_fun(fn_define, ARG_EVAL));
+    EXPORT("=",      mk_fun(fn_eq,     ARG_EVAL));
+    EXPORT("-",      mk_fun(fn_minus,  ARG_EVAL));
+    EXPORT("+",      mk_fun(fn_plus,   ARG_EVAL));
+    EXPORT("*",      mk_fun(fn_mult,   ARG_EVAL));
+    EXPORT("/",      mk_fun(fn_div,    ARG_EVAL));
+    EXPORT("%",      mk_fun(fn_mod,    ARG_EVAL));
+    EXPORT("begin",  mk_fun(fn_begin,  ARG_EVAL));    
+    EXPORT("print",  mk_fun(fn_print,  ARG_EVAL));
 }
 
 env_t* mk_env (env_t* parent)
 #define UNGETC (ungetc(c, stdin))
 #define IS(s) (!!strchr(s, c))
 #define T_ALPHA "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
-#define T_SYM (ALPHA)
+#define T_SYM (T_ALPHA"+-*/%=")
 #define T_SPACE " \t\n\r"
 #define T_DIGIT "0123456789"
 
 
     while(1) {
         GETC;
-        if(IS(T_ALPHA))
+        if(IS(T_SYM))
            *s++ = c;
         else {
             UNGETC;
     else if(IS("("))
         return read_cons();
 
-    else if(IS(T_ALPHA)) {
+    else if(IS(T_SYM)) {
         UNGETC;
         return read_sym();
     }
 int main (int argc, char** argv)
 {
     obj_t *read, *eval;
+    int repl = argc == 2;
 
     init();
 
-    printf("WELCOME TO ZOMBOLISP!\n");
+    if(repl) {
+        printf("WELCOME TO ZOMBOLISP!\n");
+        printf("repl mode.\n");
 
-    while(!eof()) {
-        printf("> ");
-        read = read_obj();
+        while(!feof(stdin)) {
+            printf("> ");
+            read = read_obj();
 
-        printf("read=> ");
-        print_obj(read);
-        printf("\n");
+            printf("read=> ");
+            print_obj(read);
+            printf("\n");
 
-        eval = eval_obj(read, global_env);
-        printf("eval=> ");
-        print_obj(eval);
-        printf("\n");
+            eval = eval_obj(read, global_env);
+            printf("eval=> ");
+            print_obj(eval);
+            printf("\n");
+        }
+    }
+
+    else {
+        while(!eof()) {
+            read = read_obj();
+            eval = eval_obj(read, global_env);
+        }
     }
     return 0;
 }