Skip to content

Instantly share code, notes, and snippets.

@greghendershott
Created November 21, 2012 04:14
Show Gist options
  • Save greghendershott/4122971 to your computer and use it in GitHub Desktop.
Save greghendershott/4122971 to your computer and use it in GitHub Desktop.
#lang racket
(require (for-syntax syntax/parse racket/syntax racket/list racket/match))
;; First, a syntax class to recognize function arguments:
(begin-for-syntax
(define-splicing-syntax-class argspec
#:description "argument"
#:attributes (id def kw)
(pattern id:id #:with kw #f #:with def #f)
(pattern [id:id def:expr] #:with kw #f)
(pattern (~seq kw:keyword id:id) #:with def #f)
(pattern (~seq kw:keyword [id:id def:expr]))))
(begin-for-syntax
;; Sort argumnents:
;; 1. Required, by-position (preserving original order).
;; 2. Required, keyword in alphabetical order.
;; 3. Optional, by-position (preserving original order).
;; 4. Optional, keyword in alphabetical order.
;;
;; Example:
;; (a #:kwa kwa #:kwb kwb [b 0] #:opt-kwa [kwa 0] #:opt-kwb [kwb 0])
;;
;; It should normalize to that, even if it's given for example:
;; (#:kwb kwb #:kwa kwa a #:opt-kwb [kwb 0] #:opt-kwa [kwa 0] [b 0])
(define (sort-args stxs)
(define (arg-vals x)
(match (syntax->datum x)
[(list (list n d)) (values 1 "")]
[(list kw (list n d)) (values 1 (keyword->string kw))]
[(list n) (values 0 "")]
[(list kw n) (values 0 (keyword->string kw))]))
(define (arg<? a b)
(define-values (a-def a-kw) (arg-vals a))
(define-values (b-def b-kw) (arg-vals b))
(or (< a-def b-def)
(and (= a-def b-def)
(string<? a-kw b-kw))))
(sort stxs arg<?)))
(define-syntax (lam stx)
;; Parse into argspecs (e.g. "#:kw [n 0]" is one thing).
(syntax-parse stx
[(_ (arg:argspec ...) body ...+)
;; Sort the args.
(syntax-parse (for/list ([x (sort-args (syntax->list #'(arg ...)))])
(datum->syntax x x))
;;(datum->syntax stx (sort-args (syntax->datum #'(arg ...))))
[(arg ...)
;; append* them down to decl format (e.g. #:kw [n 0] is again
;; multiple things), and reparse back into argspecs. Why? We
;; want to use syntax class selectors, like arg.id, sorted the
;; same way.
(syntax-parse (syntax->list #'(arg ...))
[((arg:argspec ...) ...)
;; And append* back down to decl format, which we'll need
;; for the lambda argument declaration.
(syntax-parse #'(arg ... ...)
[((arg-decl ...) ...)
;; Whew. Finally we're ready to do the template.
#'(lambda (arg-decl ... ...)
;; Silly example of using arg.id
(displayln arg.id) ... ...
body ...)])])])]))
(define-syntax (define-lam stx)
(syntax-parse stx
[(_ (name:id arg ...) body ...+)
#'(define name (lam (arg ...) body ...))]))
(define f1 (lam (#:kw k x y) (list x y k)))
(f1 0 #:kw 2 1)
(define-lam (f2 #:kw k x y) (list x y k))
(f2 0 #:kw 2 1)
(define f3 (lam (#:kw kw a b [x 0] [y 0] #:kw-opt [z 0]) (list x y z)))
(f3 #:kw 25 'a 'b 10 20 #:kw-opt 30)
(define-lam (f4 #:kw kw a b [x 0] [y 0] #:kw-opt [z 0]) (list x y z))
(f3 #:kw 25 'a 'b 10 20 #:kw-opt 30)
@greghendershott
Copy link
Author

This works by using both:

  1. The example Tobias Hammer gave on the mailing list, so that the unavoidable trip through syntax->datum and datum->syntax preserves the lexical context for each argument. Lines 48-49.
  2. The example Jon Rafkind gave on #racket, to use a pattern (instead of using append* which would entail doing more of 1).

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment