From 56df584eed3a7228ca06a9ed1e49272410a7e671 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sat, 23 Jul 2022 11:06:55 -0700
Subject: Add a delete method to the red-black tree.

God damn delete is even more complicated than insert. I think it works,
at least.
---
 csc/macros.csc | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

(limited to 'csc/macros.csc')

diff --git a/csc/macros.csc b/csc/macros.csc
index 41225ae..1edecd2 100644
--- a/csc/macros.csc
+++ b/csc/macros.csc
@@ -365,7 +365,7 @@
 
 
     (define (identifier-uuid i)
-      ; Join marks by ( because symbols aren't allowed to have ( in the name.
+      ; Join marks by ( because symbols are unlikely to have ( in the name.
       (sprintf "{}({}" (apply join "(" (map number->string (marks i))) (identifier-name i)))
 
 
@@ -373,12 +373,27 @@
       (hash-bytevector (string->utf8 (identifier-uuid i))))
 
 
-    (define (identifier<? i1 i2)
-      (string<? (identifier-uuid i1) (identifier-uuid i2)))
+    (define (marks<? m1 m2)
+      (loop for m1* in m1
+            for m2* in m2
+            if (< m1* m2*)
+              return #t
+            else if (> m1* m2*)
+              return #f
+            finally (return (< (length m1) (length m2)))))
+
+
+    (define (cmp-identifiers i1 i2)
+      (cond
+        ((bound-identifier=? i1 i2) 0)
+        ((or (string<? (symbol->string (identifier-name i1)) (symbol->string (identifier-name i2)))
+             (marks<? (marks i1) (marks i2)))
+          -1)
+        (else 1)))
 
 
     (define (alist->substitutions l)
-      (alist->map hash-identifier identifier<? l))
+      (alist->map hash-identifier cmp-identifiers l))
 
 
     (define (is-underscore expression)
-- 
cgit v1.3.1