aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/list.scheme
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2023-05-01 07:56:42 -0700
committerRose Hogenson <rhogenson@posteo.net>2023-05-01 07:56:42 -0700
commita89d6c82e981fec7d6e4c975e083d2b9e04467ad (patch)
treed5445ceb797473dd45ac006c337d990e5dd6f0d4 /lib/csc/list.scheme
parentFix bugs with recursive macros and empty template. (diff)
downloadchromatopelma-a89d6c82e981fec7d6e4c975e083d2b9e04467ad.tar.zst
Rewrite most of the compiler.
This represents a major step back in terms of functionality, and amount of code. The latter I think constitutes a major win. Next steps are to reimplement syntax-rules, call/cc, and call-with-values.
Diffstat (limited to 'lib/csc/list.scheme')
-rw-r--r--lib/csc/list.scheme73
1 files changed, 73 insertions, 0 deletions
diff --git a/lib/csc/list.scheme b/lib/csc/list.scheme
new file mode 100644
index 0000000..ea25454
--- /dev/null
+++ b/lib/csc/list.scheme
@@ -0,0 +1,73 @@
+(define-library (csc list)
+ (export
+ all
+ any
+ filter
+ foldl
+ foldr
+ intersperse
+ map-maybe)
+ (import (scheme base))
+ (begin
+
+
+ (define (any1 f l)
+ (and (not (null? l))
+ (or (f (car l))
+ (any1 f (cdr l)))))
+
+
+ (define (any f . ls)
+ (and (not (any1 null? ls))
+ (or (apply f (map car ls))
+ (apply any f (map cdr ls)))))
+
+
+ (define (all f . ls)
+ (or (any null? ls)
+ (and (apply f (map car ls))
+ (apply all f (map cdr ls)))))
+
+
+ (define (foldl f acc . ls)
+ (if (any null? ls)
+ acc
+ (apply foldl f (apply f acc (map car ls)) (map cdr ls))))
+
+
+ (define (foldr f acc . ls)
+ (if (any null? ls)
+ acc
+ (apply f (append (map car ls) (list (apply foldr f acc (map cdr ls)))))))
+
+
+ (define (map-maybe f l)
+ (foldr
+ (lambda (x acc)
+ (define fx (f x))
+ (if fx
+ (cons fx acc)
+ acc))
+ '()
+ l))
+
+
+ (define (filter f l)
+ (foldr
+ (lambda (x acc)
+ (if (f x)
+ (cons x acc)
+ acc))
+ '()
+ l))
+
+
+ (define (intersperse sep l)
+ (if (null? l)
+ '()
+ (cons (car l)
+ (foldr
+ (lambda (x acc)
+ (cons sep (cons x acc)))
+ '()
+ (cdr l)))))))