|
|
|
@ -7,14 +7,11 @@
|
|
|
|
|
(all-from-out parser-tools/lex-sre)
|
|
|
|
|
[struct-out token-struct]
|
|
|
|
|
token
|
|
|
|
|
[struct-out exn:fail:parsing]
|
|
|
|
|
apply-tokenizer
|
|
|
|
|
trim-ends
|
|
|
|
|
from/to)
|
|
|
|
|
[struct-out exn:fail:parsing])
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(struct token-struct (type val offset line column span skip?)
|
|
|
|
|
#:transparent)
|
|
|
|
|
#:transparent)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Token constructor.
|
|
|
|
@ -24,14 +21,14 @@
|
|
|
|
|
(define token
|
|
|
|
|
(lambda (type ;; (U symbol string)
|
|
|
|
|
[val #f] ;; any
|
|
|
|
|
#:offset [offset #f] ;; (U #f number)
|
|
|
|
|
#:position [position #f] ;; (U #f number)
|
|
|
|
|
#:line [line #f] ;; (U #f number)
|
|
|
|
|
#:column [column #f] ;; (U #f number)
|
|
|
|
|
#:span [span #f] ;; boolean
|
|
|
|
|
#:skip? [skip? #f])
|
|
|
|
|
(token-struct (if (string? type) (string->symbol type) type)
|
|
|
|
|
val
|
|
|
|
|
offset line column span skip?)))
|
|
|
|
|
position line column span skip?)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; When bad things happen, we need to emit errors with source location.
|
|
|
|
@ -41,27 +38,48 @@
|
|
|
|
|
(exn:fail:parsing-srclocs instance)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide apply-tokenizer)
|
|
|
|
|
(define (apply-tokenizer tokenize in)
|
|
|
|
|
(define input-port (if (string? in)
|
|
|
|
|
(open-input-string in)
|
|
|
|
|
in))
|
|
|
|
|
(define token-producer (tokenize input-port))
|
|
|
|
|
(for/list ([token (in-producer token-producer (λ(token)
|
|
|
|
|
;; position-tokens are produced by lexer-src-pos
|
|
|
|
|
(eq? eof (if (position-token? token)
|
|
|
|
|
(position-token-token token)
|
|
|
|
|
token))))])
|
|
|
|
|
token))
|
|
|
|
|
(define input-port (if (string? in)
|
|
|
|
|
(open-input-string in)
|
|
|
|
|
in))
|
|
|
|
|
(define token-producer (tokenize input-port))
|
|
|
|
|
(for/list ([token (in-producer token-producer (λ(token)
|
|
|
|
|
;; position-tokens are produced by lexer-src-pos
|
|
|
|
|
(eq? eof (if (position-token? token)
|
|
|
|
|
(position-token-token token)
|
|
|
|
|
token))))])
|
|
|
|
|
token))
|
|
|
|
|
|
|
|
|
|
(provide trim-ends)
|
|
|
|
|
(define (trim-ends left lexeme right)
|
|
|
|
|
(string-trim (string-trim lexeme left #:right? #f) right #:left? #f))
|
|
|
|
|
|
|
|
|
|
(provide from/to)
|
|
|
|
|
(define-lex-trans from/to
|
|
|
|
|
(λ(stx)
|
|
|
|
|
(syntax-case stx ()
|
|
|
|
|
[(_ OPEN CLOSE)
|
|
|
|
|
#'(:seq OPEN (complement (:seq any-string CLOSE any-string)) CLOSE)])))
|
|
|
|
|
|
|
|
|
|
;; change names of lexer abbreviations to be consistent with Racket srcloc conventions
|
|
|
|
|
|
|
|
|
|
(provide start-loc)
|
|
|
|
|
(define-syntax start-loc (make-rename-transformer #'start-pos))
|
|
|
|
|
|
|
|
|
|
(provide end-loc)
|
|
|
|
|
(define-syntax end-loc (make-rename-transformer #'end-pos))
|
|
|
|
|
|
|
|
|
|
(provide loc-line)
|
|
|
|
|
(define-syntax loc-line (make-rename-transformer #'position-line))
|
|
|
|
|
|
|
|
|
|
(provide loc-column)
|
|
|
|
|
(define-syntax loc-column (make-rename-transformer #'position-col))
|
|
|
|
|
|
|
|
|
|
(provide loc-position)
|
|
|
|
|
(define-syntax loc-position (make-rename-transformer #'position-offset))
|
|
|
|
|
|
|
|
|
|
(provide loc-span)
|
|
|
|
|
(define (loc-span start-loc end-loc)
|
|
|
|
|
(- (loc-position end-loc)
|
|
|
|
|
(loc-position start-loc)))
|