aboutsummaryrefslogtreecommitdiffstats
path: root/lib/csc/list.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-08-01 19:35:19 -0700
committerRose Hogenson <rhogenson@posteo.net>2022-08-01 19:35:19 -0700
commitacc561366f3fe6ec0377103f52ef0f7e923711c9 (patch)
treed7a19cfbad78a69ebea71b27302e708c0655863d /lib/csc/list.csc
parent99ce19a8053a93457885f32ec54c1c5b7c1961c1 (diff)
downloadchromatopelma-acc561366f3fe6ec0377103f52ef0f7e923711c9.tar.zst
Modify the project structure.
Now the lib directory contains what will eventually end up on the user's /usr/lib/csc. When I write make install, it will copy all of the .csc files from lib into the destination lib directory. This means I can start working on the standard library in lib/scheme.
Diffstat (limited to 'lib/csc/list.csc')
-rw-r--r--lib/csc/list.csc85
1 files changed, 85 insertions, 0 deletions
diff --git a/lib/csc/list.csc b/lib/csc/list.csc
new file mode 100644
index 0000000..b1c2298
--- /dev/null
+++ b/lib/csc/list.csc
@@ -0,0 +1,85 @@
+(define-library (csc list)
+ (export
+ all
+ enumerate
+ filter
+ intercalate
+ revappend
+ split-at
+ take
+ unzip)
+ (import (scheme base)
+ (only (csc loop)
+ loop
+ return)
+ (only (csc match)
+ match))
+ (begin
+
+
+ (define (take n xs)
+ (loop for x in xs
+ for i from 1 to n
+ collect x))
+
+
+ (define (split-at n xs)
+ (if (<= n 0)
+ (values '() xs)
+ (loop for i from 1 to n
+ for x in xs
+ for second-half = (cdr xs) then (cdr second-half)
+ collect x into first-half
+ finally (return (values first-half second-half)))))
+
+
+ (define (revappend a b)
+ (let loop ((xs a)
+ (acc b))
+ (if (null? xs)
+ acc
+ (loop (cdr xs) (cons (car xs) acc)))))
+
+
+ (define (intercalate x l)
+ (match l
+ ('() '())
+ ((_) l)
+ ((head . tail) (cons head (cons x (intercalate x tail))))))
+
+
+ (define (enumerate l)
+ (let loop ((i 0)
+ (l l))
+ (match l
+ ('() '())
+ ((head . tail) (cons (cons i head) (loop (+ 1 i) tail))))))
+
+
+ (define (filter p l)
+ (let loop ((l l)
+ (acc '()))
+ (match l
+ ('() (reverse acc))
+ ((x . xs)
+ (if (p x)
+ (loop xs (cons x acc))
+ (loop xs acc))))))
+
+
+ (define (unzip l)
+ (loop for x in l
+ collect (car x) into xs
+ collect (cdr x) into ys
+ finally (return (values xs ys))))
+
+
+ (define (all pred . ls)
+ (loop for ls = ls then (map cdr ls)
+ while (loop for l in ls
+ if (null? l)
+ return #f
+ finally (return #t))
+ unless (apply pred (map car ls))
+ return #f
+ finally (return #t)))))