kw-map.rkt (1511B)
1 #lang sweet-exp racket/base 2 3 provide map 4 5 require (only-in racket/base [map rkt:map]) 6 racket/list 7 my-cond/iffy 8 "keyword-lambda.rkt" 9 module+ test 10 require rackunit 11 racket/math 12 13 define map 14 keyword-lambda (kws kw-args f . args) 15 my-cond 16 if {empty?(args) and empty?(kw-args)} 17 error('map "expected at least one list argument") 18 else-if empty?(kw-args) 19 apply(rkt:map f args) 20 else-if empty?(args) 21 for/list ([kw-args in-list(apply(rkt:map list kw-args))]) 22 keyword-apply(f kws kw-args '()) 23 else 24 define argss apply(rkt:map list args) 25 define kw-argss apply(rkt:map list kw-args) 26 unless {length(argss) = length(kw-argss)} 27 error('map "all lists must have same size, given ~v and ~v with different lengths" 28 first(args) first(kw-args)) 29 for/list ([args in-list(argss)] 30 [kw-args in-list(kw-argss)]) 31 keyword-apply(f kws kw-args args) 32 33 module+ test 34 check-equal? (map (λ (#:x x) {x + 1}) #:x '(1 2 3 4)) 35 '(2 3 4 5) 36 check-equal? (map (λ (x #:y y) {x + y}) '(1 2 3 4) #:y '(10 100 1000 10000)) 37 '(11 102 1003 10004) 38 define (KE #:m m #:v v) 39 {1/2 * m * sqr(v)} 40 check-equal? (map KE #:m '(2 2 2 2) #:v '(0 1 2 3)) 41 '(0 1 4 9) 42 check-equal? (map KE #:m '(0 1 2 3) #:v '(0 1 2 3)) 43 '(0 1/2 4 27/2) 44 check-equal? (map KE #:m '(1 2 1/2 2/9) #:v '(0 1 2 3)) 45 '(0 1 1 1) 46