From 5e758560f6b70ba40beff3d8209da8968e7e0aff Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 22 Mar 2017 13:01:07 -0700 Subject: [PATCH] simplify colorer --- brag/brag/private/colorer.rkt | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/brag/brag/private/colorer.rkt b/brag/brag/private/colorer.rkt index 03a28d3..2889485 100644 --- a/brag/brag/private/colorer.rkt +++ b/brag/brag/private/colorer.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require brag/support (submod brag/rules/lexer lex-abbrevs) brag/support racket/match) +(require brag/support (submod brag/rules/lexer lex-abbrevs) racket/match) (provide color-brag) (define brag-syntax-lexer @@ -8,32 +8,22 @@ [whitespace (return-without-srcloc (brag-syntax-lexer input-port))] [(:or (from/to "'" "'") (from/to "\"" "\"")) (token 'LIT lexeme)] [(:or (char-set "()[]|+*:") hide-char splice-char) (token 'MISC lexeme)] - [(:seq (:or "#" ";") - (complement (:seq (:* any-char) NL (:* any-char))) - (:or NL "")) - (token 'COMMENT lexeme)] + [(:seq (:or "#" ";") (complement (:seq (:* any-char) NL (:* any-char))) (:or NL "")) (token 'COMMENT lexeme)] [id (token 'ID lexeme)] [any-char (token 'OTHER lexeme)])) (define (color-brag port) - (define srcloc-tok - (with-handlers - ([exn:fail:read? - (λ (exn) (srcloc-token (token 'ERROR) (car (exn:fail:read-srclocs exn))))]) - (brag-syntax-lexer port))) + (define srcloc-tok (brag-syntax-lexer port)) (if (eof-object? srcloc-tok) (values srcloc-tok 'eof #f #f #f) - (match-let* ([(srcloc-token - (token-struct type val _ _ _ _ _) - (srcloc _ _ _ posn span)) srcloc-tok] + (match-let* ([(srcloc-token (token-struct type val _ _ _ _ _) (srcloc _ _ _ posn span)) srcloc-tok] [(cons start end) (cons posn (+ posn span))] [(cons _ cat) (or (assq type '((ID . symbol) (LIT . string) (MISC . parenthesis) - (COMMENT . comment) - (ERROR . error))) + (COMMENT . comment))) (cons 'OTHER 'no-color))]) (values val cat #f start end))))