Hi guys,
I’ve been working for a little while with the idea of being able to pass
keyword arguments through a function that doesn’t define them. Additionally I
wanted to allow the “pass-through” function to define its own keywords.
Additionally didn’t want to have to pre-specify what function might be on the
receiving end of the call. But finally, if both pass-through and called
functions define the same keywords I didn’t want to have to differentiate
between them.
- This seems to involve some combination of make-keyword-procedure and
keyword-apply.
- Since make-keyword-procedure expects a “vanilla” function (one without
keywords specified) I decided to define a macro that would wrap the function in
a let that with default bindings for each keyword defined by the pass-through.
Inside the function I would then assign any values provided by the function
call to those variables.
- Additionally I would build a parameterized list of keywords defined by the
pass-through chain. These would be used in conjunction with the keyword list
produced by procedure-keywords and the keywords/values captured by the function
call to “filter” the lists used by keyword-apply. The idea being to eliminate
any keyword/values supplied to the pass-through and defined by the pass-through
that were not defined by the called function. This would allow keywords not
defined by either to be error by the called function.
As you can see, it’s a convoluted approach and I’m not sure how robust it
actually. I’m presenting working code (for my test cases…) but also wondering
if someone hasn’t already crated that wheel. :)
#lang racket
(require (for-syntax syntax/parse
racket/syntax))
(define current-caller-kw (make-parameter '()))
(define (get-kw-val w v kw kv)
(define key (string->keyword (symbol->string w)))
(define kws (list->vector kw))
(define idx (vector-member key kws))
(cond
[(false? idx) v]
[else (define kvs (list->vector kv))
(vector-ref kvs idx)]))
(define-syntax (def stx)
(syntax-parse stx
[(_ (f ((w v) ...) k ... . ks) body0 body ...)
(with-syntax ([kw (format-id #'f "kw")]
[kv (format-id #'f "kv")])
#'(define f
(let ([w v] ...)
(make-keyword-procedure
(λ (kw kv k ... . ks)
(parameterize ([current-caller-kw
(append (current-caller-kw)
(map (λ (x) (string->keyword
(symbol->string x)))
(list 'w ...)))])
(set! w (get-kw-val 'w w kw kv)) ...
body0 body ...))))))]))
(define (filter/kw ckw fkw kw kv)
(cond
[(empty? ckw) (values kw kv)]
[(empty? (remove* fkw ckw)) (values kw kv)]
[else
(define diff (remove* fkw ckw))
(define vkw (list->vector kw))
(define vkv (list->vector kv))
(for/fold ([wacc '()] [vacc '()])
([v kv]
[k kw] #:unless (member k diff))
(values (append wacc (list k)) (append vacc (list v))))]))
(define (h #:c c . x) (list c x))
(def (g ((c 0)) . args)
(define-values (rkw akw) (procedure-keywords h))
(define-values (Δkw Δkv) (filter/kw (current-caller-kw) akw kw kv))
(list c (keyword-apply h
Δkw
Δkv
args)))
(def (f ((a 0)(b 0)) n p . ns) (list kw kv a b n p ns (keyword-apply g
kw
kv
ns)))
;=> '((#:a #:c) (42 52) 42 0 2 3 (4 5) (52 (52 (4 5))))
(f 2 3 4 5 #:a 42 #:c 52)
;=> application: procedure does not expect an argument with given keyword
; procedure: h
; given keyword: #:z
; arguments...:
(f 2 3 4 5 #:z 42 #:c 52)
Kevin
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit
https://groups.google.com/d/msgid/racket-users/27D5D96D-F9D9-4ECB-9AE0-92FD1EB065C8%40gmail.com.
