1#lang lazy/base 2 3(require 4 (prefix-in ! racket/list) 5 (except-in 6 racket/list 7 first second third fourth fifth sixth seventh eighth 8 rest last-pair 9 make-list 10 take drop split-at takef dropf splitf-at 11 take-right drop-right split-at-right takef-right dropf-right splitf-at-right 12 add-between 13 append* 14 flatten 15 remove-duplicates 16 filter-map count partition 17 range 18 append-map 19 filter-not 20 argmin argmax)) 21 22(provide (all-from-out racket/list) 23 last-pair 24 take drop split-at takef dropf splitf-at 25 take-right drop-right split-at-right takef-right dropf-right splitf-at-right 26 add-between 27 append* 28 flatten 29 remove-duplicates 30 filter-map count partition 31 range 32 append-map 33 filter-not 34 argmin argmax) 35 36;; lazy versions of exports from racket/list 37;; --------------------------------------------------------------------------------------------------- 38 39(define (last-pair p) 40 (let ([p (! p)]) 41 (unless (pair? p) 42 (raise-argument-error 'last-pair "pair?" p)) 43 (let loop ([p p]) 44 (define next (! (cdr p))) 45 (if (pair? next) (loop next) p)))) 46 47(define (make-list n v) 48 (let ([n (! n)]) 49 (unless (exact-nonnegative-integer? n) 50 (raise-argument-error 'make-list "exact-nonnegative-integer?" 0 n v)) 51 (let loop ([n n] 52 [acc '()]) 53 (if (zero? n) acc 54 (loop (sub1 n) (cons v acc)))))) 55 56(define (take l n) 57 (let ([n (! n)]) 58 (unless (exact-nonnegative-integer? n) 59 (raise-argument-error 'take "exact-nonnegative-integer?" 1 l n)) 60 (let loop ([n n] [l l]) 61 (if (zero? n) 62 '() 63 (let ([l (! l)]) 64 (cond [(null? l) 65 ;; it would be fine to force the whole list (since we now 66 ;; know it's finite), but doing so means keeping a reference 67 ;; to its head, which can lead to memory leaks. 68 (raise-arguments-error 'take 69 "index is too large for input list" 70 "index" n)] 71 [(pair? l) (cons (car l) (loop (sub1 n) (! (cdr l))))] 72 [else (raise-argument-error 'take "list?" l)])))))) 73 74(define (split-at l n) 75 (let ([n (! n)]) 76 (unless (exact-nonnegative-integer? n) 77 (raise-argument-error 'split-at "exact-nonnegative-integer?" 1 l n)) 78 (let loop ([n n] [l l]) 79 (if (zero? n) 80 (values '() l) 81 (let ([l (! l)]) 82 (cond [(null? l) 83 ;; see comment for `take` 84 (raise-arguments-error 'split-at 85 "index is too large for input list" 86 "index" n)] 87 [(pair? l) 88 (define-values (a b) (loop (sub1 n) (! (cdr l)))) 89 (values (cons (car l) a) b)] 90 [else (raise-argument-error 'split-at "list?" l)])))))) 91 92(define (drop lst pos) 93 (list-tail lst pos)) 94 95(define (takef lst pred) 96 (let ([pred (! pred)]) 97 (unless (procedure? pred) 98 (raise-argument-error 'takef "procedure?" 1 lst pred)) 99 (let loop ([lst (! lst)]) 100 (cond 101 [(and (pair? lst) (! (pred (car lst)))) 102 (cons (car lst) (loop (cdr lst)))] 103 [else '()])))) 104 105(define (dropf lst pred) 106 (let ([pred (! pred)]) 107 (unless (procedure? pred) 108 (raise-argument-error 'takef "procedure?" 1 lst pred)) 109 (let loop ([lst (! lst)]) 110 (cond 111 [(and (pair? lst) (! (pred (car lst)))) 112 (loop (cdr lst))] 113 [else lst])))) 114 115(define (splitf-at lst pred) 116 (let ([pred (! pred)]) 117 (unless (procedure? pred) 118 (raise-argument-error 'takef "procedure?" 1 lst pred)) 119 (let loop ([lst (! lst)]) 120 (cond 121 [(and (pair? lst) (! (pred (car lst)))) 122 (define-values (a b) (loop (cdr lst))) 123 (values (cons (car lst) a) b)] 124 [else (values '() lst)])))) 125 126(define (take-right l n) 127 (drop l (- (improper-length l) n))) 128 129(define (drop-right l n) 130 (take l (- (improper-length l) n))) 131 132(define (split-at-right l n) 133 (split-at l (- (improper-length l) n))) 134 135(define (takef-right l pred) 136 (improper-reverse (takef (improper-reverse l) pred))) 137 138(define (dropf-right l pred) 139 (improper-reverse (dropf (improper-reverse l) pred))) 140 141(define (splitf-at-right l pred) 142 (improper-reverse (splitf-at (improper-reverse l) pred))) 143 144;; keyword arguments currently do not work to due Lazy Racket limitations 145(define (add-between lst v 146 #:before-first [before-first '()] 147 #:before-last [before-last v] 148 #:after-last [after-last '()] 149 #:splice? [splice? #f]) 150 (define middle 151 (let ([lst (!list lst)]) 152 (cons (car lst) 153 (let loop ([lst (cdr lst)]) 154 (cond 155 [(null? lst) '()] 156 [else ((if splice? append list*) 157 (if (null? (cdr lst)) before-last v) 158 (if splice? (list (car lst)) (car lst)) 159 (loop (cdr lst)))]))))) 160 (if splice? 161 (append before-first middle after-last) 162 middle)) 163 164(define (append* . args) 165 (define-values (head tail) (split-at-right args 1)) 166 (apply append (append head (apply append tail)))) 167 168(define (flatten v) 169 (let ([v (! v)]) 170 (cond 171 [(pair? v) (append (flatten (car v)) (flatten (cdr v)))] 172 [(null? v) '()] 173 [else (list v)]))) 174 175(define (remove-duplicates lst [same? equal?] #:key [extract-key (λ (x) x)]) 176 (let loop ([lst (!list lst)]) 177 (if (null? lst) '() 178 (cons (car lst) (loop (remove* (list (car lst)) lst 179 (λ (a b) (same? (extract-key a) (extract-key b))))))))) 180 181(define (filter-map proc lst . lsts) 182 (let loop ([lsts (cons lst lsts)]) 183 (cond 184 [(null? (! (car lsts))) '()] 185 [else 186 (define result (apply proc (map car lsts))) 187 (if result 188 (cons result (loop (map cdr lsts))) 189 (loop (map cdr lsts)))]))) 190 191(define (count proc lst . lsts) 192 (let loop ([lsts (cons lst lsts)] 193 [acc 0]) 194 (cond 195 [(null? (! (car lsts))) acc] 196 [else 197 (define result (apply proc (map car lsts))) 198 (loop (map cdr lsts) (if result (add1 acc) acc))]))) 199 200(define (partition pred lst) 201 (let loop ([lst (!list lst)]) 202 (cond 203 [(null? lst) (values '() '())] 204 [else 205 (define-values (a b) (loop (cdr lst))) 206 (if (pred (car lst)) 207 (values (cons (car lst) a) b) 208 (values a (cons (car lst) b)))]))) 209 210(define range 211 (case-lambda 212 [(end) (range 0 end)] 213 [(start end) (range start end 1)] 214 [(start end step) 215 (let loop ([n start]) 216 (cond 217 [(if (positive? step) 218 (n . >= . end) 219 (n . <= . end)) '()] 220 [else 221 (cons n (loop (+ n step)))]))])) 222 223(define (append-map proc lst . lsts) 224 (append* (apply map proc lst lsts))) 225 226(define (filter-not pred lst) 227 (filter (λ (x) (not (pred x))) lst)) 228 229(define (argmin proc lst) 230 (!argmin proc (!list lst))) 231 232(define (argmax proc lst) 233 (!argmax proc (!list lst))) 234 235;; internal utility functions 236;; --------------------------------------------------------------------------------------------------- 237 238(define (improper-length lst) 239 (let loop ([n 0] [lst (! lst)]) 240 (cond 241 [(pair? lst) (loop (add1 n) (! (cdr lst)))] 242 [else n]))) 243 244(define (improper-reverse lst) 245 (let loop ([lst (! lst)] 246 [acc '()]) 247 (cond 248 [(pair? lst) (loop (! (cdr lst)) (cons (car lst) acc))] 249 [else acc]))) 250