www

commit 3eedd771b064347a1574fcbf0d7115a5a5aa3250
parent 2b71ce7ac5f8837302a53b9ba21d58c31cae4fc3
Author: AlexKnauth <alexander@knauth.org>
Date:   Mon, 20 Apr 2015 20:23:13 -0400

add kw-hash.rkt

Diffstat:
A
kw-utils/keyword-app.rkt
 | 
15
+++++++++++++++
A
kw-utils/kw-hash.rkt
 | 
57
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++

2 files changed, 72 insertions(+), 0 deletions(-)
diff --git a/kw-utils/keyword-app.rkt b/kw-utils/keyword-app.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+
+(provide keyword-app
+         keyword-app/sort
+         )
+
+(require "keyword-apply-sort.rkt"
+         )
+
+(define (keyword-app f kws kw-args . rst-args)
+  (keyword-apply f kws kw-args rst-args))
+
+(define (keyword-app/sort f kws kw-args . rst-args)
+  (keyword-apply/sort f kws kw-args rst-args))
+
diff --git a/kw-utils/kw-hash.rkt b/kw-utils/kw-hash.rkt
@@ -0,0 +1,57 @@
+#lang racket/base
+
+(provide apply/kw-hash
+         app/kw-hash
+         make-kw-hash
+         make-kw-hash+list
+         keyword-app-make-kw-hash
+         )
+
+(require "keyword-lambda.rkt"
+         "keyword-app.rkt"
+         )
+(module+ test
+  (require rackunit racket/math))
+
+;; (apply/kw-hash proc kw-hash arg ... rst-args)
+(define apply/kw-hash
+  (keyword-lambda (kws kw-args proc kw-hash . other-args)
+    (define kw-lop
+      (sort (hash->list kw-hash) keyword<? #:key car))
+    (keyword-apply keyword-apply kws kw-args proc (map car kw-lop) (map cdr kw-lop) other-args)))
+
+(define app/kw-hash
+  (keyword-lambda (kws kw-args proc kw-hash . rst-args)
+    (keyword-app apply/kw-hash kws kw-args proc kw-hash rst-args)))
+
+;; equivalent to (keyword-app make-kw-hash kws kw-args)
+(define (keyword-app-make-kw-hash kws kw-args)
+  (make-immutable-hash
+   (for/list ([kw     (in-list kws)]
+              [kw-arg (in-list kw-args)])
+     (cons kw kw-arg))))
+
+(define make-kw-hash
+  (keyword-lambda (kws kw-args)
+    (keyword-app-make-kw-hash kws kw-args)))
+
+(define make-kw-hash+list
+  (keyword-lambda (kws kw-args . args)
+    (define kw-hash
+      (keyword-app-make-kw-hash kws kw-args))
+    (values kw-hash args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(module+ test
+  (test-case "apply/kw-hash"
+    (check-equal? (apply/kw-hash list (hash) 0 1 '(2 3))
+                  '(0 1 2 3))
+    (check-equal? (app/kw-hash list (hash) 0 1 '(2 3))
+                  '(0 1 (2 3)))
+    (define (kinetic-energy #:m m #:v v)
+      (* 1/2 m (sqr v)))
+    (check-equal? (apply/kw-hash kinetic-energy (hash '#:m 2 '#:v 1) '())
+                  1)
+    )
+  )