diff --git a/implementations/c/src/evaluator.c b/implementations/c/src/evaluator.c index e3c9e05..7bc8db3 100644 --- a/implementations/c/src/evaluator.c +++ b/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; } } diff --git a/implementations/c/src/lisp.c b/implementations/c/src/lisp.c index c346dc9..95001d2 100644 --- a/implementations/c/src/lisp.c +++ b/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) { diff --git a/implementations/c/src/lisp.h b/implementations/c/src/lisp.h index 6e1b21b..3095e2b 100644 --- a/implementations/c/src/lisp.h +++ b/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 diff --git a/implementations/c/src/printer.c b/implementations/c/src/printer.c index 18b6eba..d027f74 100644 --- a/implementations/c/src/printer.c +++ b/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;