find-defined-pvars.rkt (1754B)
1 #lang racket 2 ;; This module is an experiment to extract the pattern variables defined by a 3 ;; define/with-syntax form (it could easily be made to work with 4 ;; define/syntax-parse too). Ti relies on inspecting current-pvars before and 5 ;; after the define/with-syntax form. In order to be able to access the updated 6 ;; current-pvars, the macro needs to call a second macro which gets expanded 7 ;; after the define/with-syntax. 8 9 (require stxparse-info/parse 10 stxparse-info/case) 11 (require stxparse-info/current-pvars 12 (for-syntax racket/list)) 13 14 (define result #f) 15 16 (define-syntax (continue stx) 17 (syntax-case stx () 18 [(_ old-pvars-stx) 19 (let () 20 (define old-pvars (syntax->list #'old-pvars-stx)) 21 (define now-pvars (current-pvars)) 22 (define-values (new-pvars rest-pvars) 23 (split-at now-pvars (- (length now-pvars) (length old-pvars)))) 24 (unless (andmap free-identifier=? old-pvars rest-pvars) 25 (log-error 26 (string-append "Internal error: The tail of current-pvars changed" 27 " between two calls.\n" 28 " Before: ~a\n" 29 " After: ~a\n" 30 " New items: ~a" 31 old-pvars 32 rest-pvars 33 new-pvars))) 34 ;; Return the result for tests: 35 #`(set! result '#,new-pvars))])) 36 37 (define-syntax (find-defined-pvars stx) 38 (syntax-case stx () 39 [(_ pat val) 40 #`(begin 41 (define/with-syntax pat val) 42 (continue #,(current-pvars)))])) 43 44 (define/with-syntax (a . b) #'(1 2)) 45 (find-defined-pvars (x . y) #'(3 4)) 46 (define/with-syntax (c . d) #'(5 6)) 47 48 (module+ test 49 (require rackunit) 50 (check-equal? result '(y x)))