www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

keyword-apply-sort.rkt (1083B)

      1 #lang racket/base
      2 
      3 (provide keyword-apply/sort)
      4 
      5 (require "keyword-lambda.rkt")
      6 
      7 (module+ test
      8   (require rackunit racket/local racket/math))
      9 
     10 ;; like keyword-apply, but without the constraint that the kws must be sorted
     11 (define keyword-apply/sort
     12   (keyword-lambda (kws kw-args f other-kws other-kw-args . rest-args)
     13     (let* ([kw-lop (for/list ([kw     (in-list (append kws     other-kws))]
     14                               [kw-arg (in-list (append kw-args other-kw-args))])
     15                      (cons kw kw-arg))]
     16            [sorted-kw-lop (sort kw-lop keyword<? #:key car)]
     17            [sorted-kws     (map car sorted-kw-lop)]
     18            [sorted-kw-args (map cdr sorted-kw-lop)])
     19       (keyword-apply f sorted-kws sorted-kw-args (apply list* rest-args)))))
     20 
     21 (module+ test
     22   (local []
     23     (define (kinetic-energy #:mass m #:velocity v)
     24       (* 1/2 m (sqr v)))
     25     (check-equal? (keyword-apply/sort kinetic-energy '(#:mass #:velocity) '(2 1) '())
     26                   1)
     27     (check-equal? (keyword-apply/sort kinetic-energy '(#:velocity #:mass) '(1 2) '())
     28                   1)
     29     ))
     30