make syntax->string work with pairs and _

fixes #1628 and #1629
This commit is contained in:
lkh01 2019-11-14 23:16:53 +01:00 committed by Sam Tobin-Hochstadt
parent 4d4e75983e
commit 627d164a46
2 changed files with 26 additions and 2 deletions

View File

@ -0,0 +1,9 @@
#lang racket
(require syntax/to-string
rackunit)
(check-equal? (syntax->string #'((a .
b))) "(a . \n b)")
(check-equal? (syntax->string #'((a b c d))) "(a b c d)")
(check-equal? (syntax->string #'(a 'b #(a b c) c)) "a 'b #(a b c) c")
(check-equal? (syntax->string #'((a b _ d))) "(a b _ d)")

View File

@ -27,7 +27,10 @@
(cond
[(eq? 'code:blank (syntax-e c))
(advance c init-line!)]
[(eq? '_ (syntax-e c)) (void)]
[(eq? '_ (syntax-e c))
(advance c init-line!)
(printf "_")
(set! col (+ col 1))]
[(eq? '... (syntax-e c))
(void)]
[(and (pair? (syntax-e c))
@ -58,7 +61,19 @@
(define c-paren-shape (syntax-property c 'paren-shape))
(printf "~a" (or c-paren-shape #\())
(set! col (+ col 1))
(map (loop init-line!) (syntax->list c))
(define se (syntax-e c))
(define (build-string-from-pair sp)
(cond
[(syntax? sp)
(printf " . ")
(set! col (+ col 3))
((loop init-line!) sp)]
[else
((loop init-line!) (car sp))
(build-string-from-pair (cdr sp))]))
(if (list? se)
(map (loop init-line!) se)
(build-string-from-pair se))
(printf (case c-paren-shape
[(#\[) "]"]
[(#\{) "}"]