aboutsummaryrefslogtreecommitdiffstats
path: root/csc/compare.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-07-24 20:28:56 -0700
committerRose Hogenson <rhogenson@posteo.net>2022-07-24 20:28:56 -0700
commit498040c3d1532bb6de01dbbb55348f631c3745d6 (patch)
tree32a1b7ed7ec176f8eaa46092d4a8cd74a050375b /csc/compare.csc
parent745d6b8e16c7f276f479c18d97200e44d16aafc9 (diff)
downloadchromatopelma-498040c3d1532bb6de01dbbb55348f631c3745d6.tar.zst
Fix some bugs in the compare library.
Diffstat (limited to 'csc/compare.csc')
-rw-r--r--csc/compare.csc38
1 files changed, 22 insertions, 16 deletions
diff --git a/csc/compare.csc b/csc/compare.csc
index dea2366..794d795 100644
--- a/csc/compare.csc
+++ b/csc/compare.csc
@@ -5,8 +5,6 @@
(only (csc loop)
loop
return)
- (only (csc match) match)
- (only (csc sort) sort)
(only (csc strings)
contains
split)
@@ -28,20 +26,24 @@
(define (alist? l)
- (match l
- (((key . _) . _)
- (symbol? key))
- (_ #f)))
+ (and (list? l)
+ (loop for x in l
+ unless (and (pair? x)
+ (symbol? (car x)))
+ return #f
+ finally (return #t))))
(define (transform x transformers)
(define x* (apply-transformer transformers x))
(cond
((alist? x*)
- (sort (lambda (a b) (string<? (symbol->string (car a)) (symbol->string (car b))))
- (map (lambda (elem)
- (cons (car elem) (transform (cdr elem) transformers)))
- x*)))
+ (map (lambda (elem)
+ (define elem* (apply-transformer transformers elem))
+ (if (pair? elem*)
+ (cons (car elem) (transform (cdr elem) transformers))
+ elem*))
+ x*))
((list? x*)
(map (lambda (elem) (transform elem transformers))
x*))
@@ -76,17 +78,17 @@
(define (pretty w x indent)
(cond
- ((and (pair? x)
- (symbol? (car x)))
- (fprintf w "{} ({} .\n" indent (car x))
- (pretty w (cdr x) (string-append indent " "))
- (fprintf w "{} )\n" indent))
((list? x)
(fprintf w "{} (\n" indent)
(loop with new-indent = (string-append indent " ")
for v in x
do (pretty w v new-indent))
(fprintf w "{} )\n" indent))
+ ((and (pair? x)
+ (symbol? (car x)))
+ (fprintf w "{} ({} .\n" indent (car x))
+ (pretty w (cdr x) (string-append indent " "))
+ (fprintf w "{} )\n" indent))
(else (fprintf w "{} {}\n" indent x))))
@@ -182,7 +184,11 @@
(set! y (cdr y))
(set! equal #f))
(fprintf w "{} )\n" indent)
- equal))))
+ equal))
+ (else
+ (pretty w x (string-append indent "-"))
+ (pretty w y (string-append indent "+"))
+ #f)))
(define default-transformers