From acc561366f3fe6ec0377103f52ef0f7e923711c9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 Aug 2022 19:35:19 -0700
Subject: 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.
---
 lib/csc/list.csc | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 lib/csc/list.csc

(limited to 'lib/csc/list.csc')

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)))))
-- 
cgit v1.3.1