diff --git a/brag/brag/support.rkt b/brag/brag/support.rkt index 423d3a8..c154c0d 100755 --- a/brag/brag/support.rkt +++ b/brag/brag/support.rkt @@ -11,22 +11,24 @@ [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?) #:auto-value #f - #: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?)))))]) + #:transparent) ;; Token constructor. @@ -59,11 +61,11 @@ (open-input-string in) in)) (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 - (eq? eof (if (position-token? token) - (position-token-token token) - token))))]) + (eq? eof (if (position-token? tok) + (position-token-token tok) + tok))))]) token)) (provide trim-ends)