hide-comments.rkt (2771B)
1 #lang racket 2 3 (require (rename-in syntax/parse [...+ …+]) 4 syntax/stx 5 racket/match 6 racket/set 7 racket/list 8 racket/function 9 racket/vector 10 racket/contract 11 sexp-diff 12 racket/pretty 13 rackunit 14 (only-in racket/base [... …]) 15 (for-syntax (rename-in racket/base [... …])) 16 "syntax-properties.rkt") 17 18 (provide hide-#%comment) 19 20 ;; ([#%comment c1] a [#%comment c2] . ([#%comment c3] b [#%comment c4])) 21 ;; => (aᶜ² . (bᶜ⁴)⁻ᶜ³)⁻ᶜ¹ 22 ;; (c1 a c2 . (c3 . (c4 b c5))) 23 ;; => (aᶜ² . (bᶜ⁵)⁻ᶜ³⁻⁻ᶜ⁴)⁻ᶜ¹ 24 ;; (c1 a c2 . (c3 . (c4 c5))) 25 ;; => (aᶜ² . ()⁻ᶜ³⁻⁻ᶜ⁴ᶜ⁵)⁻ᶜ¹ 26 ;; (c1 a (c2) b) 27 ;; => (a ()⁻ᶜ² b)⁻ᶜ¹ 28 ;; (c1 a (c2 . b) c) 29 ;; => (a b⁻ᶜ² c)⁻ᶜ¹ 30 ;; (c1 a (c2 . (c3 c4)) c) 31 ;; => (a ()⁻ᶜ²⁻⁻ᶜ³ᶜ⁴ c)⁻ᶜ¹ 32 (define (hide-#%comment stx) 33 (match (syntax-e stx) 34 [(not (? pair?)) 35 ;; TODO: recurse down vectors etc. 36 stx] 37 [(list* e* ... rest) 38 (syntax-parse e* 39 #:datum-literals (#%comment) 40 [({~and c₀ [#%comment . _]} … 41 {~seq {~and eᵢ {~not [#%comment . _]}} 42 {~and cᵢⱼ [#%comment . _]} …} 43 …+) 44 (define new-e* (map with-comments-after 45 (map hide-#%comment 46 (syntax->list #'(eᵢ …))) 47 (map syntax->list 48 (syntax->list #'((cᵢⱼ …) …))))) 49 (define new-rest (if (null? rest) 50 rest 51 (hide-#%comment rest))) 52 (with-first-comments 53 (datum->syntax stx (append new-e* new-rest) stx stx) 54 (cons #f (syntax->list #'(c₀ …))))] 55 [({~and c₀ [#%comment . _]} …) 56 (define new-rest (if (null? rest) 57 rest 58 (hide-#%comment rest))) 59 (with-first-comments 60 (with-comments-after 61 (datum->syntax stx new-rest stx stx) 62 (if (syntax? new-rest) 63 (syntax-property new-rest 'comments-after) 64 '())) 65 (cons (if (syntax? new-rest) 66 (cons (datum->syntax new-rest 67 'saved-props+srcloc 68 new-rest 69 new-rest) 70 (or (syntax-property new-rest 'first-comments) 71 ;; TODO: I'm dubious about this, better typecheck 72 ;; everything… 73 (cons #f null))) 74 #f) 75 (syntax->list #'(c₀ …))))])]))