zo parse & marshal updates for preserved syntax properties

This commit is contained in:
Matthew Flatt 2016-03-09 19:35:02 -07:00
parent 209a4ff631
commit 976c5e6e2b
2 changed files with 28 additions and 9 deletions

View File

@ -431,12 +431,26 @@
[esrcloc (let () [esrcloc (let ()
(define (avail? n) (n . >= . 0)) (define (avail? n) (n . >= . 0))
(define (xvector a b c d e) (define (xvector a b c d e)
;; Add paren-shape info, if any:
(case (hash-ref props 'paren-shape #f) (case (hash-ref props 'paren-shape #f)
[(#\[) (vector a b c d e #\[)] [(#\[) (yvector a b c d e #\[)]
[(#\{) (vector a b c d e #\{)] [(#\{) (yvector a b c d e #\{)]
[else (if (or a (avail? b) (avail? c) (avail? d)) [else (if (or a (avail? b) (avail? c) (avail? d))
(vector a b c d e) (yvector a b c d e #f)
#f)])) #f)]))
(define (yvector a b c d e f)
;; Add properties, if any:
(if (positive? (- (hash-count props) (if f 1 0)))
(vector a b c d e f
(sort (for/list ([(k v) (in-hash props)]
#:unless (and f
(eq? k 'paren-shape)))
(cons k v))
symbol<?
#:key car))
(if f
(vector a b c d e f)
(vector a b c d e))))
(define (norm v) (or v -1)) (define (norm v) (or v -1))
(share-everywhere (share-everywhere
(if srcloc (if srcloc

View File

@ -1256,12 +1256,17 @@
(norm (vector-ref esrcloc 2)) (norm (vector-ref esrcloc 2))
(norm (vector-ref esrcloc 3)) (norm (vector-ref esrcloc 3))
(norm (vector-ref esrcloc 4)))) (norm (vector-ref esrcloc 4))))
(if (and esrcloc ((vector-length esrcloc) . > . 5)) (let ([props
(case (vector-ref esrcloc 5) (if (and esrcloc ((vector-length esrcloc) . > . 5))
[(#\[) #hasheq((paren-shape . #\[))] (case (vector-ref esrcloc 5)
[(#\{) #hasheq((paren-shape . #\{))] [(#\[) #hasheq((paren-shape . #\[))]
[else #hasheq()]) [(#\{) #hasheq((paren-shape . #\{))]
#hasheq()))))) [else #hasheq()])
#hasheq())])
(if (and esrcloc ((vector-length esrcloc) . > . 6))
(for/fold ([props props]) ([p (in-list (vector-ref esrcloc 6))])
(hash-set props (car p) (cdr p)))
props))))))
(values (car p) (cdr p))) (values (car p) (cdr p)))
;; ---------------------------------------- ;; ----------------------------------------