annotate-syntax.rkt (1740B)
1 #lang racket 2 3 (provide annotate-syntax) 4 5 (define (annotate-syntax e #:srcloc+scopes? [srcloc+scopes? #f]) 6 (cond 7 [(syntax? e) 8 (append 9 (list 'syntax 10 (append-map (λ (kᵢ) 11 (if (and (or (eq? kᵢ 'first-comments) 12 (eq? kᵢ 'comments-after)) 13 (not (syntax-property e kᵢ))) 14 (list) 15 (list kᵢ (syntax-property e kᵢ)))) 16 (syntax-property-symbol-keys e))) 17 (if srcloc+scopes? 18 (list (syntax-source e) 19 (syntax-line e) 20 (syntax-column e) 21 (syntax-position e) 22 (syntax-span e) 23 (syntax-source-module e) 24 (hash-ref (syntax-debug-info e) 'context)) 25 (list)) 26 (list (annotate-syntax (syntax-e e) #:srcloc+scopes? srcloc+scopes?)))] 27 [(null? e) 28 'null] 29 [(list? e) 30 (list 'list 31 (map (λ (eᵢ) (annotate-syntax eᵢ #:srcloc+scopes? srcloc+scopes?)) 32 e))] 33 [(pair? e) 34 (list 'cons 35 (annotate-syntax (car e) #:srcloc+scopes? srcloc+scopes?) 36 (annotate-syntax (cdr e) #:srcloc+scopes? srcloc+scopes?))] 37 [(vector? e) 38 (list 'vector 39 (immutable? e) 40 (map (λ (eᵢ) (annotate-syntax eᵢ #:srcloc+scopes? srcloc+scopes?)) 41 (vector->list e)))] 42 [(symbol? e) 43 e] 44 [(string? e) 45 e] 46 [else 47 (raise-argument-error 48 'annotate-syntax 49 (string-append "a syntax object containing recursively on of the" 50 " following: pair, null, vector, symbol, string") 51 0 52 e)]))