gistfile1.rkt

#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)

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).