Initial commit

1 files changed, 29 insertions, 0 deletions

diff --git a/algebraic-structs.applicative.list.base.scm b/algebraic-structs.applicative.list.base.scm
new file mode 100644
index 0000000..01625ff
--- /dev/null
+++ b/algebraic-structs.applicative.list.base.scm
@@ -0,0 +1,29 @@
+(module (algebraic-structs applicative list base) (map pure map2)
+  (import (except scheme map)
+          (algebraic-structs functor list)
+          (only (chicken base) atom? cut)
+          (only (srfi 1) append! reverse!)
+          matchable)
+
+  (define (pure x)
+    (list x))
+
+  (define (rev-map f lst)
+    (let loop ((lst lst)
+               (acc '()))
+      (match lst
+        [() acc]
+        [(h . t)
+         (loop t (cons (f h) acc))])))
+
+  (define (product op lst1 lst2)
+    (let loop ((lst lst1)
+               (acc '()))
+      (match lst
+        [() (reverse! acc)]
+        [(h . t)
+         (loop t
+               (append! (rev-map (cut op h <>) lst2)
+                        acc))])))
+
+  (define map2 product))