def.rkt (2030B)
1 #lang typed/racket 2 (require syntax/parse 3 phc-toolkit/percent 4 (for-syntax syntax/parse)) 5 6 (begin-for-syntax 7 (define-syntax-class parse-args 8 (pattern rest:id 9 #:with sig #'rest 10 #:with {extract ...} #'{}) 11 (pattern ({~or {~literal syntax} {~literal unsyntax}} . rest) 12 ;; The rest would need to be an stx, but that's normally impossible 13 ;; (unless there was some extension to #%app and function 14 ;; definitions which allowed this). 15 #:with sig (raise-syntax-error 16 "Unexpected syntax pattern in a tail position") 17 #:with {extract ...} #'{}) 18 (pattern (({~literal syntax} hd) . tl:parse-args) 19 #:with (tmp) (generate-temporaries #'(hd)) 20 #:with sig #'(tmp . tl.sig) 21 #:with {extract ...} #`{#'hd = tmp tl.extract ...}) 22 (pattern (({~literal unsyntax} hd:parse-args) . tl:parse-args) 23 #:with (tmp) (generate-temporaries #'(hd)) 24 #:with sig #'(tmp . tl.sig) 25 #:with {extract ...} #'{hd.sig = (syntax->datum tmp) 26 hd.extract ... 27 tl.extract ...}) 28 (pattern (hd:id . tl:parse-args) 29 #:with sig #'(hd . tl.sig) 30 #:with {extract ...} #'{tl.extract ...}) 31 (pattern {~and last ()} 32 #:with sig #'last 33 #:with {extract ...} #'{}))) 34 35 (define-syntax def 36 (syntax-parser 37 [(_ ({~literal syntax} name:id) . body) 38 #'(define-syntax name 39 (syntax-parser 40 [self:id . body]))] 41 [(_ (name:id . args:parse-args) . body) 42 #`(define (name . args.sig) 43 (% args.extract ... 44 . body))])) 45 46 #;{ 47 (def (foo #'(aa . bb) x) 48 #`(#,x bb . aa)) 49 50 (def (bar #,(aa . bb) x) 51 (list x bb aa)) 52 53 (module+ test 54 (require rackunit) 55 (check-equal? (syntax->datum 56 (foo #'(xx . yy) 42)) 57 '(42 yy . xx))) 58 }