annotate-syntax-typed.rkt (2328B)
1 #lang typed/racket 2 3 (require typed-map 4 tr-immutable/typed-syntax) 5 6 (provide annotate-syntax) 7 8 (: annotate-syntax (->* (ISyntax/Non) 9 (#:srcloc+scopes? Boolean) 10 Sexp/Non)) 11 (define (annotate-syntax e #:srcloc+scopes? [srcloc+scopes? #f]) 12 (annotate-syntax1 e srcloc+scopes?)) 13 14 (: annotate-syntax1 (→ (U ISyntax/Non ISyntax/Non-E) 15 Boolean 16 Sexp/Non)) 17 (define (annotate-syntax1 e srcloc+scopes?) 18 (cond 19 [(syntax? e) 20 (append 21 (list 'syntax 22 (append-map (λ ([kᵢ : Symbol]) 23 (if (and (or (eq? kᵢ 'first-comments) 24 (eq? kᵢ 'comments-after)) 25 (not (syntax-property e kᵢ))) 26 (list) 27 (list kᵢ (any->isexp/non (syntax-property e kᵢ))))) 28 (syntax-property-symbol-keys e))) 29 (if srcloc+scopes? 30 (list (any->isexp/non (syntax-source e)) 31 (any->isexp/non (syntax-line e)) 32 (any->isexp/non (syntax-column e)) 33 (any->isexp/non (syntax-position e)) 34 (any->isexp/non (syntax-span e)) 35 (any->isexp/non (syntax-source-module e)) 36 (any->isexp/non (hash-ref (syntax-debug-info e) 37 'context))) 38 (list)) 39 (list (annotate-syntax1 (syntax-e e) srcloc+scopes?)))] 40 [(null? e) 41 'null] 42 [(list? e) 43 (list 'list 44 (map (λ (eᵢ) (annotate-syntax1 eᵢ srcloc+scopes?)) 45 e))] 46 [(pair? e) 47 (list 'cons 48 (annotate-syntax1 (car e) srcloc+scopes?) 49 (annotate-syntax1 (cdr e) srcloc+scopes?))] 50 [(vector? e) 51 (list 'vector 52 (immutable? e) 53 (map (λ (eᵢ) (annotate-syntax1 eᵢ srcloc+scopes?)) 54 (vector->list e)))] 55 [(box? e) 56 (list 'box 57 (immutable? e) 58 (annotate-syntax1 (unbox e) srcloc+scopes?))] 59 [(or (symbol? e) 60 (string? e) 61 (boolean? e) 62 (char? e) 63 (number? e) 64 (keyword? e)) 65 e] 66 [(NonSyntax? e) 67 (list 'NonSyntax (NonSexp (NonSyntax-v e)))] 68 [(NonSexp? e) 69 (list 'NonSexp e)]))