PasteRack.org
Paste # 14898
2025-12-06 01:09:16

Fork as a new paste.

Paste viewed 139 times.


Embed:

define/kw-proc

  1. #lang racket
  2. (require racket/syntax)
  3. (require racket/stxparam)
  4.  
  5. ;; macros for shortening simple make-keyword-procedure usages
  6. (define-syntax-parameter call/kw
  7.   (λ (stx) (raise-syntax-error #f "illegal outside λ-keyword-procedure or define/kw-proc" stx)))
  8.  
  9. (define-syntax-rule (λ-keyword-procedure (ARG ...) BODY ...)
  10.   (with-syntax ([kws (generate-temporary #'kws)]
  11.                 [kw-args (generate-temporary #'kw-args)])
  12.     (make-keyword-procedure
  13.      (λ (kws kw-args ARG ...)
  14.        (syntax-parameterize
  15.            ([call/kw (syntax-rules ()
  16.                        [(call/kw FN CALL-ARG (... ...))
  17.                         (keyword-apply FN kws kw-args (list CALL-ARG (... ...)))])])
  18.          BODY ...)))))
  19.  
  20. (define-syntax-rule (define/kw-proc (NAME ARG ...) BODY ...)
  21.   (define NAME (λ-keyword-procedure (ARG ...) BODY ...)))
  22.  
  23. ;; example usage
  24. (define (inner arg #:foo [foo "foobar"] #:hello [hello 'world])
  25.   (displayln (~a "called inner with " arg " (also [foo=" foo "] and [hello=" hello "])")))
  26.  
  27. (define/kw-proc (outer lst)
  28.   (displayln (~a "called outer with " lst))
  29.   (call/kw inner (reverse lst)))
  30.  
  31. (outer '(1 2 3))
  32. (newline)
  33. (outer '(a b c) #:hello "hello!")
  34. (newline)
  35. (outer '() #:hello "hi" #:foo 'bar)

=>

called outer with (1 2 3)

called inner with (3 2 1) (also [foo=foobar] and [hello=world])

called outer with (a b c)

called inner with (c b a) (also [foo=foobar] and [hello=hello!])

called outer with ()

called inner with () (also [foo=bar] and [hello=hi])