|
|
@ -32,31 +32,30 @@
|
|
|
|
(define-lex-abbrev id (:& (complement (:+ digit)) (:+ id-char)))
|
|
|
|
(define-lex-abbrev id (:& (complement (:+ digit)) (:+ id-char)))
|
|
|
|
(define-lex-abbrev id-separator (:or ":" "::="))
|
|
|
|
(define-lex-abbrev id-separator (:or ":" "::="))
|
|
|
|
|
|
|
|
|
|
|
|
(define-lex-abbrev esc-chars (char-set "\\a\\b\\t\\n\\v\\f\\r\\e"))
|
|
|
|
(define-lex-abbrev esc-chars (union "\\a" "\\b" "\\t" "\\n" "\\v" "\\f" "\\r" "\\e"))
|
|
|
|
|
|
|
|
|
|
|
|
(define (escape-lexeme lexeme quote-char)
|
|
|
|
(define (unescape-lexeme lexeme quote-char)
|
|
|
|
;; convert the literal string representation back into an escape char with lookup table
|
|
|
|
;; convert the literal string representation back into an escape char with lookup table
|
|
|
|
;; maybe use `read` instead?
|
|
|
|
(define unescapes (hash "a" 7 "b" 8 "t" 9 "n" 10 "v" 11 "f" 12 "r" 13 "e" 27 "\"" 34 "'" 39))
|
|
|
|
(define escapes (hash "a" 7 "b" 8 "t" 9 "n" 10 "v" 11 "f" 12 "r" 13 "e" 27 "\"" 34 "'" 39))
|
|
|
|
|
|
|
|
(define pat (regexp (format "(?<=^~a\\\\).(?=~a$)" quote-char quote-char)))
|
|
|
|
(define pat (regexp (format "(?<=^~a\\\\).(?=~a$)" quote-char quote-char)))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(regexp-match pat lexeme)
|
|
|
|
[(regexp-match pat lexeme)
|
|
|
|
=> (λ (m) (string quote-char (integer->char (hash-ref escapes (car m))) quote-char))]
|
|
|
|
=> (λ (m) (string quote-char (integer->char (hash-ref unescapes (car m))) quote-char))]
|
|
|
|
[else lexeme]))
|
|
|
|
[else lexeme]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define lex/1
|
|
|
|
(define lex/1
|
|
|
|
(lexer-src-pos
|
|
|
|
(lexer-src-pos
|
|
|
|
;; handle whitespace chars within quotes as literal tokens: "\n" "\t" '\n' '\t'
|
|
|
|
;; handle whitespace & escape chars within quotes as literal tokens: "\n" "\t" '\n' '\t'
|
|
|
|
;; by matching the escaped version, and then unescaping them before they become token-LITs
|
|
|
|
;; match the escaped version, and then unescape them before they become token-LITs
|
|
|
|
[(:: "'"
|
|
|
|
[(:: "'"
|
|
|
|
(:* (:or "\\'" esc-chars (:~ "'" "\\")))
|
|
|
|
(:* (:or "\\'" esc-chars (:~ "'" "\\")))
|
|
|
|
"'")
|
|
|
|
"'")
|
|
|
|
(token-LIT (escape-lexeme lexeme #\'))]
|
|
|
|
(token-LIT (unescape-lexeme lexeme #\'))]
|
|
|
|
[(:: "\""
|
|
|
|
[(:: "\""
|
|
|
|
(:* (:or "\\\"" esc-chars (:~ "\"" "\\")))
|
|
|
|
(:* (:or "\\\"" esc-chars (:~ "\"" "\\")))
|
|
|
|
"\"")
|
|
|
|
"\"")
|
|
|
|
(token-LIT (escape-lexeme lexeme #\"))]
|
|
|
|
(token-LIT (unescape-lexeme lexeme #\"))]
|
|
|
|
["("
|
|
|
|
["("
|
|
|
|
(token-LPAREN lexeme)]
|
|
|
|
(token-LPAREN lexeme)]
|
|
|
|
["["
|
|
|
|
["["
|
|
|
@ -81,7 +80,6 @@
|
|
|
|
[(:: (:or "#" ";")
|
|
|
|
[(:: (:or "#" ";")
|
|
|
|
(complement (:: (:* any-char) NL (:* any-char)))
|
|
|
|
(complement (:: (:* any-char) NL (:* any-char)))
|
|
|
|
(:or NL ""))
|
|
|
|
(:or NL ""))
|
|
|
|
;; Skip comments up to end of line.
|
|
|
|
|
|
|
|
(return-without-pos (lex/1 input-port))]
|
|
|
|
(return-without-pos (lex/1 input-port))]
|
|
|
|
[(eof)
|
|
|
|
[(eof)
|
|
|
|
(token-EOF lexeme)]
|
|
|
|
(token-EOF lexeme)]
|
|
|
@ -119,7 +117,7 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; position->pos: position -> pos
|
|
|
|
;; position->pos: position -> pos
|
|
|
|
;; Coerses position structures from br-parser-tools/lex to our own pos structures.
|
|
|
|
;; Converts position structures from br-parser-tools/lex to our own pos structures.
|
|
|
|
(define (position->pos a-pos)
|
|
|
|
(define (position->pos a-pos)
|
|
|
|
(pos (position-offset a-pos)
|
|
|
|
(pos (position-offset a-pos)
|
|
|
|
(position-line a-pos)
|
|
|
|
(position-line a-pos)
|
|
|
@ -128,8 +126,6 @@
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; tokenize: input-port -> (-> token)
|
|
|
|
;; tokenize: input-port -> (-> token)
|
|
|
|
(define (tokenize ip
|
|
|
|
(define (tokenize ip #:source [source (object-name ip)])
|
|
|
|
#:source [source (object-name ip)])
|
|
|
|
(λ () (parameterize ([file-path source])
|
|
|
|
(lambda ()
|
|
|
|
|
|
|
|
(parameterize ([file-path source])
|
|
|
|
|
|
|
|
(lex/1 ip))))
|
|
|
|
(lex/1 ip))))
|
|
|
|