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))
|
