www

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

kw-hash.rkt (1770B)

      1 #lang racket/base
      2 
      3 (provide apply/kw-hash
      4          app/kw-hash
      5          make-kw-hash
      6          make-kw-hash+list
      7          keyword-app-make-kw-hash
      8          )
      9 
     10 (require "keyword-lambda.rkt"
     11          "keyword-app.rkt"
     12          )
     13 (module+ test
     14   (require rackunit racket/math))
     15 
     16 ;; Based on https://gist.github.com/Metaxal/578b473bc48886f81123
     17 
     18 ;; (apply/kw-hash proc kw-hash arg ... rst-args)
     19 (define apply/kw-hash
     20   (keyword-lambda (kws kw-args proc kw-hash . other-args)
     21     (define kw-lop
     22       (sort (hash->list kw-hash) keyword<? #:key car))
     23     (keyword-apply keyword-apply kws kw-args proc (map car kw-lop) (map cdr kw-lop) other-args)))
     24 
     25 (define app/kw-hash
     26   (keyword-lambda (kws kw-args proc kw-hash . rst-args)
     27     (keyword-app apply/kw-hash kws kw-args proc kw-hash rst-args)))
     28 
     29 ;; equivalent to (keyword-app make-kw-hash kws kw-args)
     30 (define (keyword-app-make-kw-hash kws kw-args)
     31   (make-immutable-hash
     32    (for/list ([kw     (in-list kws)]
     33               [kw-arg (in-list kw-args)])
     34      (cons kw kw-arg))))
     35 
     36 (define make-kw-hash
     37   (keyword-lambda (kws kw-args)
     38     (keyword-app-make-kw-hash kws kw-args)))
     39 
     40 (define make-kw-hash+list
     41   (keyword-lambda (kws kw-args . args)
     42     (define kw-hash
     43       (keyword-app-make-kw-hash kws kw-args))
     44     (values kw-hash args)))
     45 
     46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     47 
     48 (module+ test
     49   (test-case "apply/kw-hash"
     50     (check-equal? (apply/kw-hash list (hash) 0 1 '(2 3))
     51                   '(0 1 2 3))
     52     (check-equal? (app/kw-hash list (hash) 0 1 '(2 3))
     53                   '(0 1 (2 3)))
     54     (define (kinetic-energy #:m m #:v v)
     55       (* 1/2 m (sqr v)))
     56     (check-equal? (apply/kw-hash kinetic-energy (hash '#:m 2 '#:v 1) '())
     57                   1)
     58     )
     59   )