Skip to content
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

Remove more obsolete formatting markup #241

Merged
merged 2 commits into from
Aug 28, 2024
Merged

Remove more obsolete formatting markup #241

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c520e3d
Remove more obsolete formatting markup
jackfirth Aug 28, 2024
9d7cfb8
Remove more dead syntax formatting code
jackfirth Aug 28, 2024
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
148 changes: 10 additions & 138 deletions private/syntax-replacement.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@


(provide
NEWLINE
ORIGINAL-GAP
ORIGINAL-SPLICE
(contract-out
Expand All @@ -18,7 +17,6 @@
[syntax-replacement-render (-> syntax-replacement? string-replacement?)]
[syntax-replacement-original-syntax (-> syntax-replacement? (and/c syntax? syntax-original?))]
[syntax-replacement-new-syntax (-> syntax-replacement? syntax?)]
[syntax-replacement-template-drop-leading-newline (-> syntax? syntax?)]
[syntax-replacement-preserves-free-identifiers? (-> syntax-replacement? boolean?)]
[syntax-replacement-preserves-comments? (-> syntax-replacement? range-set? boolean?)]))

Expand Down Expand Up @@ -48,20 +46,6 @@
;@----------------------------------------------------------------------------------------------------


(define-syntax (NEWLINE stx)
(raise-syntax-error
#false
"should only be used by refactoring rules to indicate where newlines should be inserted"
stx))


(define-syntax (SPACE stx)
(raise-syntax-error
#false
"should only be used by refactoring rules to indicate where a space should be inserted"
stx))


(define-syntax (ORIGINAL-GAP stx)
(raise-syntax-error
#false
Expand All @@ -77,83 +61,10 @@
stx))


(define (syntax-replacement-template-drop-leading-newline template-stx)
(syntax-parse template-stx
#:literals (NEWLINE)
[(NEWLINE form ...) #'(form ...)]
[_ template-stx]))


(define-record-type syntax-replacement
(original-syntax new-syntax introduction-scope))


(define (syntax-replacement-template-infer-spaces template)

(define/guard (loop template)
(guard (not (syntax-original? template)) #:else template)
(syntax-parse template
#:literals (quote NEWLINE SPACE ORIGINAL-GAP ORIGINAL-SPLICE)

[(~or (ORIGINAL-GAP _ ...) (ORIGINAL-SPLICE _ ...) (quote _ ...)) template]

[(subform ...)
(define (contents-to-add-between left-form right-form)
(if (or (template-separator? left-form) (template-separator? right-form))
'()
(list #'SPACE)))
(define subforms-with-spaces-inside
(for/list ([subform-stx (in-syntax #'(subform ...))])
(loop subform-stx)))
(define subforms-with-spaces-between
(add-contents-between subforms-with-spaces-inside contents-to-add-between))
(datum->syntax template subforms-with-spaces-between template template)]

[_ template]))

(define flip-fresh-scope (make-syntax-introducer))
(flip-fresh-scope (loop (flip-fresh-scope template))))


(define (template-separator? stx)
(syntax-parse stx
#:literals (NEWLINE SPACE ORIGINAL-GAP)
[(~or NEWLINE SPACE (ORIGINAL-GAP _ ...)) #true]
[else #false]))


(define/guard (add-contents-between lst adder)
(guard-match (cons first-element remaining-elements) lst #:else '())
(cons
first-element
(for/list ([previous (in-list lst)]
[element (in-list remaining-elements)]
#:when #true
[inserted (append (adder previous element) (list element))])
inserted)))


(module+ test
(test-case (name-string add-contents-between)

(define (appended-strings left right)
(list (format "left: ~a" left) (format "right: ~a" right)))

(test-case "empty list"
(check-equal? (add-contents-between '() appended-strings) '()))

(test-case "singleton list"
(check-equal? (add-contents-between (list 1) appended-strings) (list 1)))

(test-case "two-element list"
(define actual (add-contents-between (list 1 2) appended-strings))
(check-equal? actual (list 1 "left: 1" "right: 2" 2)))

(test-case "many-element list"
(define actual (add-contents-between (list 1 2 3) appended-strings))
(check-equal? actual (list 1 "left: 1" "right: 2" 2 "left: 2" "right: 3" 3)))))


(define (syntax-replacement-render replacement)

(define/guard (pieces stx)
Expand All @@ -162,11 +73,7 @@
(define end (+ start (syntax-span stx)))
(list (copied-string start end)))
(syntax-parse stx
#:literals (quote SPACE NEWLINE ORIGINAL-GAP ORIGINAL-SPLICE)

[SPACE (list (inserted-string " "))]

[NEWLINE (list)]
#:literals (quote ORIGINAL-GAP ORIGINAL-SPLICE)

[(ORIGINAL-GAP ~! before after)
(define before-end (+ (sub1 (syntax-position #'before)) (syntax-span #'before)))
Expand Down Expand Up @@ -197,11 +104,12 @@
(define shape (syntax-property stx 'paren-shape))
(define opener (match shape [#false "("] [#\[ "["] [#\{ "{"]))
(define closer (match shape [#false ")"] [#\[ "]"] [#\{ "}"]))
(define subform-piece-lists
(for/list ([subform-stx (in-list (attribute subform))])
(pieces subform-stx)))
(append
(list (inserted-string opener))
(for*/list ([subform-stx (in-syntax #'(subform ...))]
[piece (in-list (pieces subform-stx))])
piece)
(join-piece-lists subform-piece-lists)
(list (inserted-string closer)))]

[(subform ... . tail-form)
Expand All @@ -212,12 +120,7 @@
(join-piece-lists
(for/list ([subform-stx (in-syntax #'(subform ...))]) (pieces subform-stx))))
(define tail-pieces (pieces #'tail-form))
(define dot-string
(cond
[(and (ends-with-newline? subform-pieces) (starts-with-newline? tail-pieces)) "."]
[(ends-with-newline? subform-pieces) ". "]
[(starts-with-newline? tail-pieces) " ."]
[else " . "]))
(define dot-string " . ")
(append
(list (inserted-string opener))
subform-pieces
Expand All @@ -226,41 +129,14 @@
(list (inserted-string closer)))]))

(match-define (syntax-replacement #:original-syntax orig-stx #:new-syntax new-stx) replacement)
(define template (syntax-replacement-template-infer-spaces new-stx))
(define start (sub1 (syntax-position orig-stx)))
(string-replacement
#:start start #:end (+ start (syntax-span orig-stx)) #:contents (pieces template)))


(define/guard (ends-with-newline? piece-list)
(guard (not (empty? piece-list)) #:else #true)
(define last-piece (last piece-list))
(guard (inserted-string? last-piece) #:else #false)
(define str (inserted-string-contents last-piece))
(equal? (string-ref str (sub1 (string-length str))) #\newline))


(define/guard (starts-with-newline? piece-list)
(guard (not (empty? piece-list)) #:else #true)
(define first-piece (first piece-list))
(guard (inserted-string? first-piece) #:else #false)
(define str (inserted-string-contents first-piece))
(equal? (string-ref str 0) #\newline))
#:start start #:end (+ start (syntax-span orig-stx)) #:contents (pieces new-stx)))


(define/guard (join-piece-lists piece-lists)
(guard (not (empty? piece-lists)) #:else '())
(append
(for/list ([piece-list (in-list piece-lists)]
[next-piece-list (in-list (rest piece-lists))]
#:when #true
[piece
(in-list
(if (or (ends-with-newline? piece-list) (starts-with-newline? next-piece-list))
piece-list
(append piece-list (list (inserted-string " ")))))])
piece)
(last piece-lists)))
(apply append (add-between piece-lists (list (inserted-string " ")))))


(module+ test
Expand Down Expand Up @@ -306,7 +182,7 @@
[(syntax-replacement #:original-syntax orig
#:new-syntax new
#:introduction-scope intro)
(define ignore (list #'SPACE #'NEWLINE #'ORIGINAL-GAP #'ORIGINAL-SPLICE))
(define ignore (list #'ORIGINAL-GAP #'ORIGINAL-SPLICE))
(for/and ([new-id (in-syntax-identifiers new)]
#:unless (member new-id ignore free-identifier=?)
#:unless (bound-identifier=? new-id (intro new-id 'remove)))
Expand All @@ -326,11 +202,7 @@
(define/guard (pieces stx)
(guard (not (syntax-original? stx)) #:else (list (syntax-source-range stx)))
(syntax-parse stx
#:literals (quote SPACE NEWLINE ORIGINAL-GAP ORIGINAL-SPLICE)

[SPACE (list)]

[NEWLINE (list)]
#:literals (quote ORIGINAL-GAP ORIGINAL-SPLICE)

[(ORIGINAL-GAP ~! before after)
(define before-end (+ (sub1 (syntax-position #'before)) (syntax-span #'before)))
Expand Down
Loading