|
|
@ -3,16 +3,21 @@
|
|
|
|
(provide basic-colorer)
|
|
|
|
(provide basic-colorer)
|
|
|
|
|
|
|
|
|
|
|
|
(define (basic-colorer port)
|
|
|
|
(define (basic-colorer port)
|
|
|
|
(define (handle-lexer-error exn)
|
|
|
|
(define (handle-lexer-error excn)
|
|
|
|
(define exn-srclocs (exn:fail:read-srclocs exn))
|
|
|
|
(define excn-srclocs (exn:fail:read-srclocs excn))
|
|
|
|
(srcloc-token (token 'ERROR) (car exn-srclocs)))
|
|
|
|
(srcloc-token (token 'ERROR) (car excn-srclocs)))
|
|
|
|
(define srcloc-tok (with-handlers ([exn:fail:read? handle-lexer-error])
|
|
|
|
(define srcloc-tok
|
|
|
|
|
|
|
|
(with-handlers ([exn:fail:read? handle-lexer-error])
|
|
|
|
(basic-lexer port)))
|
|
|
|
(basic-lexer port)))
|
|
|
|
(match srcloc-tok
|
|
|
|
(match srcloc-tok
|
|
|
|
[(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
|
|
|
|
[(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
|
|
|
|
[else
|
|
|
|
[else
|
|
|
|
(match-define (srcloc-token (token-struct type val _ _ _ _ _)
|
|
|
|
(match-define
|
|
|
|
(srcloc _ _ _ pos span)) srcloc-tok)
|
|
|
|
(srcloc-token
|
|
|
|
|
|
|
|
(token-struct type val _ _ _ _ _)
|
|
|
|
|
|
|
|
(srcloc _ _ _ posn span)) srcloc-tok)
|
|
|
|
|
|
|
|
(define start posn)
|
|
|
|
|
|
|
|
(define end (+ start span))
|
|
|
|
(match-define (list cat paren)
|
|
|
|
(match-define (list cat paren)
|
|
|
|
(match type
|
|
|
|
(match type
|
|
|
|
['STRING '(string #f)]
|
|
|
|
['STRING '(string #f)]
|
|
|
@ -24,4 +29,4 @@
|
|
|
|
["(" '(parenthesis |(|)]
|
|
|
|
["(" '(parenthesis |(|)]
|
|
|
|
[")" '(parenthesis |)|)]
|
|
|
|
[")" '(parenthesis |)|)]
|
|
|
|
[else '(no-color #f)])]))
|
|
|
|
[else '(no-color #f)])]))
|
|
|
|
(values val cat paren pos (+ pos span))]))
|
|
|
|
(values val cat paren start end)]))
|