about summary refs log tree commit diff stats
path: root/chicanery.extras.scm
blob: 24cdff9f59362f41908b345d0b869eb4ee651e47 (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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
;;; chicanery extras --- extra stuff from ur old pal acdw

(export list-map list-for-each list-append)

;; Generalized map, for-each, ...
;; List versions are renamed `list-<function>'.  Un-prefixed versions work
;; with any (default) datatype.  TODO: generalize?
(define list-map map)
(define list-for-each for-each)
(define list-append append)

(define (map proc . collections)
  (let ((first (car collections)))    ; we only need to check the first one
    (cond
     ((list? first)
      (apply list-map proc collections))
     ((vector? first)
      (apply vector-map proc collections))
     ((string? first)
      (apply string-map proc collections))
     (else (error "Bad datatype" first)))))

(define (for-each proc . collections)
  (let ((first (car collections)))    ; we only need to check the first one
    (cond
     ((list? first)
      (apply list-for-each proc collections))
     ((vector? first)
      (apply vector-for-each proc collections))
     ((string? first)
      (apply string-for-each proc collections))
     (else (error "Bad datatype" first)))))

(define (append . collections)
  (let ((first (car collections)))    ; we only need to check the first one
    (cond
     ((list? first)
      (apply list-append collections))
     ((vector? first)
      (apply vector-append collections))
     ((string? first)
      (apply string-append collections))
     ((bytevector? first)
      (apply bytevector-append collections))
     (else (error "Bad datatype" first)))))

(export ref copy)

;; Extended generic functions.
;; These functions already have a list- version defined, but no non-prefixed
;; one.  So I'm fixing that.
(define (ref collection k)
  (cond
   ((list? collection)
    (list-ref collection k))
   ((vector? collection)
    (vector-ref collection k))
   ((string? collection)
    (string-ref collection k))
   ((bytevector? collection)
    (bytevector-u8-ref collection k))
   (else (error "Bad datatype" collection))))

;; I'm not going to generalize -copy! because I don't think it's a great idea,
;; really.
(define (copy collection)
  (cond
   ((list? collection)
    (list-copy collection))
   ((vector? collection)
    (vector-copy collection))
   ((string? collection)
    (string-copy collection))
   ((bytevector? collection)
    (bytevector-copy collection))
   (else (error "Bad datatype" collection))))

;; TODO: look at set! semantics -- generalizable?