From 073105080457218e67d999d6d70610914c9effe7 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Thu, 30 Dec 2021 17:01:50 +0100
Subject: Ensure new procedures are compiled only once

---
 src/ir.h     | 14 +++++++++++++-
 src/parser.c | 39 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/src/ir.h b/src/ir.h
index d92f912..cd2100c 100644
--- a/src/ir.h
+++ b/src/ir.h
@@ -60,7 +60,7 @@ typedef enum Op {
     // - Prints the last object in the stack.
     OP_PRINT,
     // Procedures.
-    // - Requires a function name as parameter.
+    // - Consumes the last value in the stack, which must be a lambda.
     OP_CALL,
     // - Return position is on a know location of the stack based on the offset
     // of locals, parameters, etc.
@@ -135,6 +135,7 @@ typedef struct Procedure {
 
 typedef struct ProgramIr {
     Procedure **procedures;
+    Object **lambdas;
     size_t labels;
 } ProgramIr;
 
@@ -360,6 +361,9 @@ void
 compile_proc_call(ProgramIr *program, Procedure *proc, Object *obj) {
     if (IS_BUILTIN(obj->head)) {
         compile_builtin(program, proc, obj);
+    } else if (IS_LAMBDA(obj->head)) {
+        compile_object(program, proc, obj->head);
+        INST_SIMPLE(proc, OP_CALL, obj->line, obj->col);
     } else {
         assert(false && "compile_proc_call: not implemented");
     }
@@ -395,6 +399,13 @@ compile_def(ProgramIr *program, Procedure *proc, Object *obj) {
 
 void
 compile_lambda(ProgramIr *program, Procedure *proc, Object *obj) {
+    for (size_t i = 0; i < array_size(program->lambdas); ++i) {
+        if (object_equal(program->lambdas[i], obj)) {
+            INST_ARG(proc, OP_PUSH, obj, obj->line, obj->col);
+            return;
+        }
+    }
+    array_push(program->lambdas, obj);
     Procedure *lambda = proc_alloc(program, STRING("lambda"), proc);
     for (size_t i = 0; i < array_size(obj->body) - 1; i++) {
         compile_object(program, lambda, obj->body[i]);
@@ -474,6 +485,7 @@ ProgramIr
 compile(Program program) {
     ProgramIr program_ir = {0};
     array_init(program_ir.procedures, 0);
+    array_init(program_ir.lambdas, 0);
     Procedure *main = proc_alloc(&program_ir, STRING("main"), NULL);
 
     for (size_t i = 0; i < array_size(program.roots); i++) {
diff --git a/src/parser.c b/src/parser.c
index 29a0444..bd52c49 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -852,7 +852,44 @@ object_equal(Object *a, Object *b) {
             return sv_equal(&a->text, &b->text);
         } break;
         case OBJ_TYPE_BUILTIN: {
-            return a->builtin = b->builtin;
+            return a->builtin == b->builtin;
+        } break;
+        case OBJ_TYPE_PAIR: {
+            Object *a_head = a->head;
+            Object *b_head = b->head;
+            if (!object_equal(a_head, b_head)) {
+                return false;
+            }
+            Object *a_tail = a->tail;
+            Object *b_tail = b->tail;
+            while (a_tail != NULL && b_tail != NULL) {
+                if (!object_equal(a_head, b_head)) {
+                    return false;
+                }
+                a_head = a_tail->head;
+                b_head = b_tail->head;
+                a_tail = a_tail->tail;
+                b_tail = b_tail->tail;
+            }
+            if (a_tail == b_tail && object_equal(a_head, b_head)) {
+                return true;
+            }
+            return false;
+        } break;
+        case OBJ_TYPE_LAMBDA: {
+            size_t n_params_a = array_size(a->params);
+            size_t n_params_b = array_size(b->params);
+            size_t n_expr_a = array_size(a->body);
+            size_t n_expr_b = array_size(b->body);
+            if (n_params_a != n_params_b || n_expr_a != n_expr_b) {
+                return false;
+            }
+            for (size_t i = 0; i < array_size(a->body); ++i) {
+                if (!object_equal(a->body[i], b->body[i])) {
+                    return false;
+                }
+            }
+            return true;
         } break;
         default: break;
     }
-- 
cgit v1.2.1