Skip to content

Commit a3a35ab

Browse files
committed
Use functor map implementation for lone sequences
1 parent d42bad2 commit a3a35ab

File tree

2 files changed

+32
-3
lines changed

2 files changed

+32
-3
lines changed

functional-lib/data/functor.rkt

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@
1414
([c:sequence? (define map c:map)]))
1515

1616
(define/renamed map (variadic-map f . args)
17-
(if (c:sequence? (first args))
17+
(if (and (c:sequence? (first args))
18+
(not (empty? (rest args))))
1819
(apply c:map f args)
1920
(apply map f args)))

functional-test/tests/data/functor.rkt

Lines changed: 30 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
11
#lang racket/base
22

33
(require (except-in data/collection map)
4+
(prefix-in b: racket/base)
45
data/functor
6+
racket/generic
57
rackunit
68
rackunit/spec)
79

@@ -15,7 +17,33 @@
1517
(describe "map"
1618
(it "applies a function to the values inside a context"
1719
(check-equal? (map add1 (identity 25))
18-
(identity 26)))
20+
(identity 26))
21+
(check-equal? (sequence->list (map add1 (list 1 2 3)))
22+
(list 2 3 4)))
1923

2024
(it "works like zip when applied to sequences"
21-
(check-equal? (sequence->list (map + '(1 2 3) '(10 20 30))) '(11 22 33)))))
25+
(check-equal? (sequence->list (map + '(1 2 3) '(10 20 30))) '(11 22 33)))
26+
27+
(it "uses a functor map specification, if available, when applied to a sequence"
28+
(struct bag (items)
29+
#:transparent
30+
31+
#:methods gen:functor
32+
[(define (map f x)
33+
;; exclude numbers too big to fit in the bag
34+
(bag (b:filter (lambda (v)
35+
(< v 10))
36+
(b:map f (bag-items x)))))]
37+
38+
#:methods gen:sequence
39+
[(define/generic -empty? empty?)
40+
(define/generic -first first)
41+
(define/generic -rest rest)
42+
(define (empty? x)
43+
(-empty? (bag-items x)))
44+
(define (first x)
45+
(-first (bag-items x)))
46+
(define (rest x)
47+
(bag (-rest (bag-items x))))])
48+
49+
(check-equal? (map add1 (bag (list 7 8 9))) (bag (list 8 9))))))

0 commit comments

Comments
 (0)