macro

implementations/c/src/evaluator.c

@@ -2,8 +2,9 @@
 #include "lisp.h"
 
 static Pointer run_fn(Func fn, Pointer params) {
-  Pointer body = CAR(fn.code);
-  Pointer args = CDR(fn.code);
+  Pointer args = CAR(fn.code);
+  Pointer body = CDR(fn.code);
+  /* print(args, stderr); */
   Pointer env = fn.env;
   Pointer value = NIL;
   Pointer tbl = table(2);
@@ -15,7 +16,7 @@ static Pointer run_fn(Func fn, Pointer params) {
       params = CDR(params);
   }
 
-  REDUCE(body, eval_fn(body, env), value);
+  REDUCE(body, eval(CAR(body), env), value);
   return value;
 }
 
@@ -27,8 +28,11 @@ Pointer eval(Pointer data, Pointer env) {
     Pointer op = eval(CAR(data), env);
     Type type = TYPE(op);
     data = CDR(data);
-    if (type == SPECIAL_FORM) {
-      return SPECIAL_FORM(op)(data, env);
+
+    switch (type) {
+    case SPECIAL_FORM: return SPECIAL_FORM(op)(data, env);
+    case MACRO: return eval(run_fn(FUNC(op), data), env);
+    default: break;
     }
     
     Pointer params = NIL;
@@ -49,10 +53,10 @@ Pointer eval(Pointer data, Pointer env) {
     if (type == FUNC) {
       return run_fn(FUNC(op), params);
     }
-    printf("%s: %d\n", __FILE__, __LINE__);
     return UNDEFINED;
   } 
-  case SYMBOL: return environment_get(env, data);
+  case SYMBOL:
+    return environment_get(env, data);
   default: return data;
   }
 }

implementations/c/src/lisp.c

@@ -31,6 +31,13 @@ Pointer func(Pointer code, Pointer env) {
   return fn;
 }
 
+Pointer macro(Pointer code, Pointer env) {
+  Pointer fn = memory_new(MACRO, sizeof(Func));
+  FUNC(fn).code = code;
+  FUNC(fn).env = env;
+  return fn;
+}
+
 /** FUNCTIONS **/
 
 Pointer add_fn(Pointer args, Pointer env) {
@@ -198,11 +205,75 @@ Pointer fn_fn(Pointer args, Pointer env) {
   return func(args, env);
 }
 
+Pointer defmacro_fn(Pointer args, Pointer env) {
+  return environment_set(NIL, CAR(args), macro(CDR(args), env));
+}
+
 Pointer exit_fn(Pointer args, Pointer env) {
   (void) args; (void) env;
   exit(1);
 }
 
+Pointer eq_fn(Pointer args, Pointer env) {
+  (void) env;
+  Pointer a = CAR(args);
+  Pointer b = CAR(CDR(args));
+  Type type = TYPE(a);
+
+  if (type != TYPE(b)) {
+    return NIL;
+  }
+
+  switch (type) {
+  case NUMBER: 
+    return NUMBER(a) == NUMBER(b) ? T : NIL;
+  case STRING:
+    return strcmp(STRING(a).data, STRING(b).data) == 0 ? T : NIL;
+  default:
+    return a == b ? T : NIL;
+  }
+}
+
+Pointer lt_fn(Pointer args, Pointer env) {
+  (void) env;
+  Pointer a = CAR(args);
+  Pointer b = CAR(CDR(args));
+  if (TYPE(a) != NUMBER || TYPE(b) != NUMBER) {
+    return UNDEFINED;
+  }
+  return NUMBER(a) < NUMBER(b) ? T : NIL;
+}
+
+Pointer gt_fn(Pointer args, Pointer env) {
+  (void) env;
+  Pointer a = CAR(args);
+  Pointer b = CAR(CDR(args));
+  if (TYPE(a) != NUMBER || TYPE(b) != NUMBER) {
+    return UNDEFINED;
+  }
+  return NUMBER(a) > NUMBER(b) ? T : NIL;
+}
+
+Pointer le_fn(Pointer args, Pointer env) {
+  (void) env;
+  Pointer a = CAR(args);
+  Pointer b = CAR(CDR(args));
+  if (TYPE(a) != NUMBER || TYPE(b) != NUMBER) {
+    return UNDEFINED;
+  }
+  return NUMBER(a) <= NUMBER(b) ? T : NIL;
+}
+
+Pointer ge_fn(Pointer args, Pointer env) {
+  (void) env;
+  Pointer a = CAR(args);
+  Pointer b = CAR(CDR(args));
+  if (TYPE(a) != NUMBER || TYPE(b) != NUMBER) {
+    return UNDEFINED;
+  }
+  return NUMBER(a) >= NUMBER(b) ? T : NIL;
+}
+
 #define SET_FUNC(s, fn) environment_set(NIL, symbol1(s), native_func(fn))
 #define SET_FORM(s, fn) environment_set(NIL, symbol1(s), special_form(fn))
 
@@ -232,6 +303,11 @@ void init(void) {
   SET_FUNC("peek-char", peek_char_fn);
   SET_FUNC("read-char", read_char_fn);
   SET_FUNC("exit", exit_fn);
+  SET_FUNC("=", eq_fn);
+  SET_FUNC("<", lt_fn);
+  SET_FUNC(">", gt_fn);
+  SET_FUNC("<=", le_fn);
+  SET_FUNC(">=", ge_fn);
 
   SET_FORM("if", if_fn);
   SET_FORM("let", let_fn);
@@ -241,6 +317,7 @@ void init(void) {
   SET_FORM("def", def_fn);
   SET_FORM("set", set_fn);
   SET_FORM("fn", fn_fn);
+  SET_FORM("defmacro", defmacro_fn);
 }
 
 void repl(void) {

implementations/c/src/lisp.h

@@ -12,12 +12,13 @@ typedef enum {
   SPECIAL_FORM, // 4
   STREAM,       // 5
   FUNC,         // 6
-  STRING,       // 7
-  TABLE,        // 8
-  ARRAY,        // 9
-  CONS,         // 10
-  ERROR,        // 11
-  TYPE_ALL      // 12
+  MACRO,        // 7
+  STRING,       // 8
+  TABLE,        // 9
+  ARRAY,        // 10
+  CONS,         // 11
+  ERROR,        // 12
+  TYPE_ALL      // 13
 } Type;
 
 typedef unsigned Pointer;
@@ -50,8 +51,6 @@ typedef struct {
 } Array;
 
 typedef struct {
-  /* Pointer args; */
-  /* Pointer body; */
   Pointer code, env;
 } Func;
 
@@ -167,6 +166,7 @@ Pointer string(char* string, size_t size);
 Pointer cons(Pointer car, Pointer cdr);
 Pointer number(Number num);
 Pointer func(Pointer code, Pointer env);
+Pointer macro(Pointer code, Pointer env);
 Pointer native_func(NativeFunc func);
 Pointer special_form(SpecialForm func);
 Pointer character(Char c);
@@ -196,6 +196,11 @@ Pointer set_reader_macro_fn(Pointer args, Pointer env);
 Pointer print_fn(Pointer args, Pointer env);
 Pointer not_fn(Pointer args, Pointer env);
 Pointer exit_fn(Pointer args, Pointer env);
+Pointer eq_fn(Pointer args, Pointer env);
+Pointer lt_fn(Pointer args, Pointer env);
+Pointer gt_fn(Pointer args, Pointer env);
+Pointer le_fn(Pointer args, Pointer env);
+Pointer ge_fn(Pointer args, Pointer env);
 
 /* SPECIAL FORMS */
 Pointer if_fn(Pointer args, Pointer env);
@@ -206,6 +211,7 @@ Pointer or_fn(Pointer args, Pointer env);
 Pointer def_fn(Pointer args, Pointer env);
 Pointer set_fn(Pointer args, Pointer env);
 Pointer fn_fn(Pointer args, Pointer env);
+Pointer defmacro_fn(Pointer args, Pointer env);
 
 #define TYPE(p)         memory_get(p)->type
 #define SIZE(p)         memory_get(p)->size

implementations/c/src/printer.c

@@ -34,7 +34,7 @@ Pointer prin1(Pointer data, Stream stream) {
   case NATIVE_FUNC: fprintf(stream, "NATIVE_FUNC"); break;
   case SPECIAL_FORM: fprintf(stream, "SPECIAL_FORM"); break;
   case FUNC:
-    prin1(LIST(symbol("fn", sizeof("fn")), FUNC(data).code), stream);
+    prin1(cons(symbol("fn", sizeof("fn")), FUNC(data).code), stream);
     break;
   case SYMBOL: fprintf(stream, "%.*s", SYMBOL(data).length, SYMBOL(data).data); break;
   case STRING: fprintf(stream, "%.*s", STRING(data).length, STRING(data).data); break;