aboutsummaryrefslogtreecommitdiff
path: root/algebraic-structs.applicative.list.base.scm
blob: 01625ff628c882ef4ad16fc4b4fb7bdb654cb0fb (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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))