Skip to content

Stop traversing whole subtrees to decide if syntax is one line or many #841

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
jackfirth wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Stop traversing whole subtrees to decide if syntax is one line or many #841

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
62 changes: 48 additions & 14 deletions default-recommendations/private/syntax-lines.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,9 +10,8 @@
[multiline-syntax? (-> any/c boolean?)]))


(require rebellion/streaming/reducer
rebellion/streaming/transducer
resyntax/private/syntax-traversal)
(require resyntax/private/syntax-traversal
syntax/parse)


(module+ test
Expand All @@ -25,18 +24,40 @@


(define (oneline-syntax? v)
(and (syntax? v) (equal? (syntax-line-count v) 1)))
(and (syntax? v) (equal? (syntax-line-count v #:limit 2) 1)))


(define (multiline-syntax? v)
(and (syntax? v) (> (syntax-line-count v) 1)))


(define (syntax-line-count stx)
(transduce (syntax-search stx [:atom])
(mapping syntax-line)
(deduplicating)
#:into into-count))
(and (syntax? v) (> (syntax-line-count v #:limit 2) 1)))


;; Counts how many distinct source lines the atoms within stx occupy, giving up and returning limit
;; as soon as that many distinct lines have been seen. Both predicates above only need to
;; distinguish between zero, one, and multiple lines, and they're checked against enough syntax
;; objects that traversing entire subtrees after the answer is already determined shows up as a
;; large chunk of Resyntax's runtime.
(define (syntax-line-count stx #:limit limit)
(let/ec return
(define lines-seen '())
(let loop ([stx stx])
(syntax-parse stx
[:atom
(define line (syntax-line this-syntax))
(unless (member line lines-seen)
(set! lines-seen (cons line lines-seen))
(when (>= (length lines-seen) limit)
(return limit)))]
[(part ...)
#:cut
(for ([part-stx (in-list (attribute part))])
(loop part-stx))]
[(part ...+ . tail-part)
#:cut
(for ([part-stx (in-list (attribute part))])
(loop part-stx))
(loop #'tail-part)]
[_ (void)]))
(length lines-seen)))


(module+ test
Expand All @@ -48,7 +69,16 @@
c)))
(check-false (oneline-syntax? #'(1
2
3))))
3)))
(check-true (oneline-syntax? #'(a . b)))
(check-false (oneline-syntax? #'(a .
b)))
(check-false (oneline-syntax? 'not-syntax))

;; Syntax objects containing no atoms at all occupy zero lines, so they're neither one-line nor
;; multiline.
(check-false (oneline-syntax? #'()))
(check-false (multiline-syntax? #'())))

(test-case (name-string multiline-syntax?)
(check-false (multiline-syntax? #'a))
Expand All @@ -58,4 +88,8 @@
c)))
(check-true (multiline-syntax? #'(1
2
3)))))
3)))
(check-false (multiline-syntax? #'(a . b)))
(check-true (multiline-syntax? #'(a .
b)))
(check-false (multiline-syntax? 'not-syntax))))
Loading