restore standard token-struct printing

dev-srcloc
Matthew Butterick 8 years ago
parent 8c1cba99ed
commit 09297e0cad

@ -11,14 +11,11 @@
[struct-out exn:fail:parsing]) [struct-out exn:fail:parsing])
(struct token-struct (type val offset line column span skip?)
#:auto-value #f (define (token-print token port mode)
#:transparent (write-string (format "~a"
#:methods gen:custom-write (cons 'token-struct
[(define write-proc (map (λ(proc) (format "~v" (proc token)))
(make-constructor-style-printer
(lambda (obj) 'token)
(lambda (obj) (map (λ(proc) (proc obj))
(list (list
token-struct-type token-struct-type
token-struct-val token-struct-val
@ -26,7 +23,12 @@
token-struct-column token-struct-column
token-struct-offset token-struct-offset
token-struct-span token-struct-span
token-struct-skip?)))))]) token-struct-skip?)))) port))
(struct token-struct (type val offset line column span skip?)
#:auto-value #f
#:transparent)
;; Token constructor. ;; Token constructor.
@ -59,11 +61,11 @@
(open-input-string in) (open-input-string in)
in)) in))
(define token-producer (tokenize input-port)) (define token-producer (tokenize input-port))
(for/list ([token (in-producer token-producer (λ(token) (for/list ([token (in-producer token-producer (λ(tok)
;; position-tokens are produced by lexer-src-pos ;; position-tokens are produced by lexer-src-pos
(eq? eof (if (position-token? token) (eq? eof (if (position-token? tok)
(position-token-token token) (position-token-token tok)
token))))]) tok))))])
token)) token))
(provide trim-ends) (provide trim-ends)

Loading…
Cancel
Save