restore standard token-struct printing

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

@ -11,22 +11,24 @@
[struct-out exn:fail:parsing]) [struct-out exn:fail:parsing])
(define (token-print token port mode)
(write-string (format "~a"
(cons 'token-struct
(map (λ(proc) (format "~v" (proc token)))
(list
token-struct-type
token-struct-val
token-struct-line
token-struct-column
token-struct-offset
token-struct-span
token-struct-skip?)))) port))
(struct token-struct (type val offset line column span skip?) (struct token-struct (type val offset line column span skip?)
#:auto-value #f #:auto-value #f
#:transparent #:transparent)
#:methods gen:custom-write
[(define write-proc
(make-constructor-style-printer
(lambda (obj) 'token)
(lambda (obj) (map (λ(proc) (proc obj))
(list
token-struct-type
token-struct-val
token-struct-line
token-struct-column
token-struct-offset
token-struct-span
token-struct-skip?)))))])
;; 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