syntax "define"

src/eval.c

@@ -11,10 +11,15 @@
 
 static struct Object *lookup(struct Object *namespace, struct Object *name);
 
-static struct Object *eval_list(struct Object *object);
+static struct Object *eval_list(
+    struct Object *object,
+    struct Object *environment
+);
 
-struct Object *eval_str(const char *const str)
+struct Object *eval_str(
-{
+    const char *const str,
+    struct Object *const environment
+) {
     assert(str);
 
     Tokens tokens = Tokens_new();
@@ -34,16 +39,21 @@ struct Object *eval_str(const char *const str)
     struct Object *const program = parse(tokens);
     TOKENS_DELETE(tokens);
 
-    return eval(program);
+    return eval(program, environment);
 }
 
-struct Object *eval(struct Object *const object)
+struct Object *eval(
-{
+    struct Object *const object,
+    struct Object *const environment
+) {
+    assert(Object_is_pair(environment));
+    assert(OBJECT_IS_NULL(environment->pair.cdr));
+
     // NULL is an empty list, can't eval
-    assert(object);
+    assert(!OBJECT_IS_NULL(object));
 
     // SYMBOL performs lookup
-    if (Object_is_symbol(object)) return lookup(NULL, object);
+    if (Object_is_symbol(object)) return lookup(environment->pair.car, object);
 
     // Almost everything evaluates to itself
     if (!Object_is_pair(object)) return object;
@@ -52,19 +62,30 @@ struct Object *eval(struct Object *const object)
     struct Object *const args = object->pair.cdr;
 
     if (Object_is_symbol(func_expr)) {
-        if (strcmp(func_expr->s, "begin") == 0) return syntax_begin(args);
+        if (strcmp(func_expr->s, "begin") == 0) {
-        if (strcmp(func_expr->s, "quote") == 0) return syntax_quote(args);
+            return syntax_begin(args, environment);
-        if (strcmp(func_expr->s, "if")    == 0) return syntax_if(args);
+        }
+        if (strcmp(func_expr->s, "define") == 0) {
+            return syntax_define(args, environment);
+        }
+        if (strcmp(func_expr->s, "quote") == 0) {
+            return syntax_quote(args, environment);
+        }
+        if (strcmp(func_expr->s, "if") == 0) {
+            return syntax_if(args, environment);
+        }
     }
 
-    struct Object *const func = eval(func_expr);
+    struct Object *const func = eval(func_expr, environment);
     assert(Object_is_procedure(func));
-    struct Object *const evaluated_args = eval_list(args);
+    struct Object *const evaluated_args = eval_list(args, environment);
     return Object_procedure_call(func, evaluated_args);
 }
 
-struct Object *eval_list(struct Object *const object)
+struct Object *eval_list(
-{
+    struct Object *const object,
+    struct Object *const environment
+) {
     assert(OBJECT_IS_LIST_HEAD(object));
 
     if (OBJECT_IS_NULL(object)) return NULL;
@@ -72,12 +93,12 @@ struct Object *eval_list(struct Object *const object)
     if (OBJECT_IS_NULL(object->pair.car)) {
         return Object_new_pair(
             NULL,
-            eval_list(object->pair.cdr)
+            eval_list(object->pair.cdr, environment)
         );
     } else {
         return Object_new_pair(
-            eval(object->pair.car),
+            eval(object->pair.car, environment),
-            eval_list(object->pair.cdr)
+            eval_list(object->pair.cdr, environment)
         );
     }
 }

src/eval.h

@@ -3,7 +3,7 @@
 
 #include "object.h"
 
-struct Object *eval_str(const char * str);
+struct Object *eval_str(const char * str, struct Object *environment);
-struct Object *eval(struct Object *object);
+struct Object *eval(struct Object *object, struct Object *environment);
 
 #endif

src/main.c

@@ -32,6 +32,8 @@ void repl()
 {
     printf("Lisp by Causa Arcana\n\n");
 
+    struct Object *const environment = Object_new_pair(NULL, NULL);
+
     while (true) {
         Tokens tokens = Tokens_new();
         assert(tokens);
@@ -60,14 +62,17 @@ void repl()
         struct Object *const program = parse(tokens);
         TOKENS_DELETE(tokens);
 
-        struct Object *const result = eval(program);
+        struct Object *const result = eval(program, environment);
 
         printf("=> ");
-        eval(Object_build_list(
+        eval(
-            2,
+            Object_build_list(
-            Object_new_symbol("displayln"),
+                2,
-            Object_build_list(2, Object_new_symbol("quote"), result)
+                Object_new_symbol("displayln"),
-        ));
+                Object_build_list(2, Object_new_symbol("quote"), result)
+            ),
+            environment
+        );
     }
 }
 
@@ -92,5 +97,6 @@ void script()
     struct Object *const program = parse(tokens);
     TOKENS_DELETE(tokens);
 
-    eval(program);
+    struct Object *const environment = Object_new_pair(NULL, NULL);
+    eval(program, environment);
 }

src/syntax.c

@@ -5,20 +5,46 @@
 
 #include <assert.h>
 
-struct Object *syntax_begin(struct Object *args)
+struct Object *syntax_begin(
-{
+    struct Object *args,
+    struct Object *const environment
+) {
     assert(OBJECT_IS_LIST_HEAD(args));
     struct Object *result = NULL;
     while (!OBJECT_IS_NULL(args)) {
         assert(Object_is_pair(args));
-        result = eval(args->pair.car);
+        result = eval(args->pair.car, environment);
         args = args->pair.cdr;
     }
     return result;
 }
 
-struct Object *syntax_if(struct Object *const args)
+struct Object *syntax_define(
-{
+    struct Object *const args,
+    struct Object *const environment
+) {
+    assert(Object_is_pair(args));
+    struct Object *const name = args->pair.car;
+    assert(Object_is_symbol(name));
+    assert(Object_is_pair(args->pair.cdr));
+    struct Object *const value_expr = args->pair.cdr->pair.car;
+    assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr));
+
+    assert(Object_is_pair(environment));
+    assert(OBJECT_IS_NULL(environment->pair.cdr));
+    assert(OBJECT_IS_LIST_HEAD(environment->pair.car));
+    environment->pair.car = Object_new_pair(
+        Object_new_pair(name, eval(value_expr, environment)),
+        environment->pair.car
+    );
+
+    return NULL;
+}
+
+struct Object *syntax_if(
+    struct Object *const args,
+    struct Object *const environment
+) {
     assert(Object_is_pair(args));
     struct Object *const cond = args->pair.car;
     struct Object *const then_else_list = args->pair.cdr;
@@ -32,14 +58,18 @@ struct Object *syntax_if(struct Object *const args)
     assert(OBJECT_IS_NULL(else_list->pair.cdr));
 
     if (Object_is_false(cond)) {
-        return eval(else_branch);
+        return eval(else_branch, environment);
     } else {
-        return eval(then_branch);
+        return eval(then_branch, environment);
     }
 }
 
-struct Object *syntax_quote(struct Object *const args)
+struct Object *syntax_quote(
-{
+    struct Object *const args,
+    struct Object *const environment
+) {
+    (void)environment; // unused
+
     assert(Object_is_pair(args));
     assert(OBJECT_IS_NULL(args->pair.cdr));
     return args->pair.car;

src/syntax.h

@@ -3,8 +3,9 @@
 
 #include "object.h"
 
-struct Object *syntax_begin(struct Object *args);
+struct Object *syntax_begin(struct Object *args, struct Object *environment);
-struct Object *syntax_if(struct Object *args);
+struct Object *syntax_define(struct Object *args, struct Object *environment);
-struct Object *syntax_quote(struct Object *args);
+struct Object *syntax_if(struct Object *args, struct Object *environment);
+struct Object *syntax_quote(struct Object *args, struct Object *environment);
 
 #endif

tests/syntax.scm

@@ -5,6 +5,21 @@
   (assert-equal 456 (begin 123 456))
   (assert-equal 789 (begin 123 456 789))
 
+  ;;; define ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  (assert-equal
+    '(123 579)
+    (begin
+      (define x 123)
+      (define y (+ x 456))
+      (list x y)))
+  (assert-equal
+    '(123 456)
+    (begin
+      (define x 123)
+      (define old x)
+      (define x 456)
+      (list old x)))
+
   ;;; if ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (assert-equal 123 (if #true 123 456))
   (assert-equal 123 (if "foo" 123 456))