Racket: Lexer and Parser
This article ports lexer from Go implementation and ports parser from Rust implementation to Racket.
1. Lexer
First, we need some structures that record metadata for us.
(struct pos (line column) #:transparent) (struct lexer (name input ; list char state ; for report position as format: (line, column) line column ; lexing helpers offset start tokens) #:mutable #:transparent) (struct token (typ val pos) #:transparent)
Then we need some helpers to handle some char utilities.
(define (alpha-numeric? c)
(and (char? c)
(or (char-ci=? c #\_)
(char-alphabetic? c)
(char-numeric? c))))
(define (end-of-line? c)
(match c
[#\newline #t]
[else #f]))
Core is state-function, which using function as state to run up a state machine.
(define (run lexer)
(when (lexer-state lexer)
(set-lexer-state! lexer
((lexer-state lexer) lexer))
(run lexer)))
Some utilities about update input char flow and metadata.
(define (next l)
(set-lexer-offset! l (add1 (lexer-offset l)))
(set-lexer-column! l (add1 (lexer-column l)))
(define c (peek-char (lexer-input l)
(- (lexer-offset l) (lexer-start l))))
(if (eof-object? c)
c
(when (end-of-line? c)
(set-lexer-line! l (add1 (lexer-line l)))
(set-lexer-column! l 0))))
(define (peek l) (peek-char (lexer-input l)
(- (lexer-offset l) (lexer-start l))))
(define (ignore l)
(read-string (- (lexer-offset l) (lexer-start l))
(lexer-input l))
(set-lexer-start! l (lexer-offset l)))
(define (new-item l ty value)
(channel-put (lexer-tokens l) (token ty value (pos (lexer-line l) (lexer-column l)))))
(define (emit l ty)
(define value
(read-string (- (lexer-offset l) (lexer-start l))
(lexer-input l)))
(match value
[(? eof-object?) (new-item l 'EOF value)]
["true" (new-item l 'true value)]
["false" (new-item l 'false value)]
["and" (new-item l 'and value)]
["or" (new-item l 'or value)]
[else (new-item l ty value)])
(set-lexer-start! l (lexer-offset l)))
(define (accept? l valid)
(cond
[(and (char? (peek l))
(string-contains? valid (string (peek l))))
(next l)
#t]
[else #f]))
(define (accept-run l valid)
(let loop ([c (peek l)])
(when (and (char? c) (string-contains? valid (string c)))
(next l)
(loop (peek l)))))
(define (scan-number? l)
(define digits "0123456789")
(when (and (accept? l "0") (accept? l "xX"))
(set! digits "0123456789abcdefABCDEF"))
(accept-run l digits)
(when (accept? l ".")
(accept-run l digits))
(when (accept? l "eE")
(accept? l "+-")
(accept-run l "0123456789"))
; Next thing mustn't be alphanumeric.
(cond
[(alpha-numeric? (peek l))
(next l)
#f]
[else #t]))
Our state functions.
(define (lex-white-space l)
(let loop ([c (peek l)])
(when (and (not (eof-object? c))
(or (char-whitespace? c)
(end-of-line? c)))
(next l)
(loop (peek l))))
(ignore l)
(match (peek l)
[(? eof-object?) (emit l 'EOF)
#f]
[#\+ (next l)
(emit l 'add)
lex-white-space]
[#\- (next l)
(emit l 'sub)
lex-white-space]
[#\* (next l)
(emit l 'mul)
lex-white-space]
[#\/ (next l)
(emit l 'div)
lex-white-space]
[#\^ (next l)
(emit l '^)
lex-white-space]
[#\= (next l)
(emit l 'eq)
lex-white-space]
[(? char-numeric?) lex-number]
[(? alpha-numeric?) lex-identifier]
[c (error 'unknown "don't know what to do with: `~a`" c)]))
(define (lex-identifier l)
(let loop ([c (peek l)])
(when (alpha-numeric? c)
(next l)
(loop (peek l))))
(emit l 'identifier)
lex-white-space)
(define (lex-number l)
(when (not (scan-number? l))
(error 'bad-number-syntax "bad number syntax: `~a`"
(peek-string (- (lexer-offset l) (lexer-start l))
0 (lexer-input l))))
(emit l 'number)
lex-white-space)
Finally, put them together.
(define (lex name input-port)
(define l (lexer name
input-port
; state
lex-white-space
; line column
1 0
; start offset
0 0
(make-channel)))
(thread (λ () (run l)))
l)
2. Parser
Utilities
(struct parser (name lexer tokens offset)
#:mutable
#:transparent)
(define (parse name input)
(define lexer (lex name input))
(define p (parser name lexer (vector) 0))
(parse-expr p #f 1))
(define (peek p [n 0])
(get-token p (+ (parser-offset p) n)))
(define (take p)
(define origin (parser-offset p))
(set-parser-offset! p (add1 origin))
(get-token p origin))
(define (consume p . wants)
(predict p wants))
(define (predict p . wants)
(for ([i (length wants)]
[want wants])
(define tok (peek p i))
(unless (eq? (token-typ tok) want)
(error 'unexpected-token "want ~a, got ~a" want (token-typ tok)))))
(define (get-token p fixed-offset)
(when (vector-empty? (parser-tokens p))
(increase-token-stream p))
(define tokens (parser-tokens p))
(if (>= fixed-offset (vector-length tokens))
(let ([last-token (vector-ref tokens (sub1 (vector-length tokens)))])
(case (token-typ last-token)
[(EOF) last-token]
[else (increase-token-stream p)
(get-token p fixed-offset)]))
(vector-ref tokens fixed-offset)))
(define (increase-token-stream p)
(define l (parser-lexer p))
(define new-last-token (channel-get (lexer-tokens l)))
(set-parser-tokens! p
(vector-append (parser-tokens p) (vector new-last-token))))
Operators utilities.
(define (right-assoc? token)
(case (token-typ token)
[(^) #t]
[else #f]))
(define (precedence token)
(define op** '((eq)
(and or)
(add sub)
(mul div ^)))
(define m (make-hash))
(for ([i (length op**)]
[op* op**])
(for ([op op*])
(hash-set! m op (+ 2 i))))
(hash-ref m (token-typ token) 0))
Ast
(struct expr () #:transparent) (struct binary expr (op left right) #:transparent)
Parsers
(define (parse-expr p left-hand-side previous-primary)
(define lhs (if left-hand-side
left-hand-side
(parse-unary p)))
(let loop ([lookahead (peek p)])
(when (>= (precedence lookahead) previous-primary)
(define operator lookahead)
(take p)
(define rhs (parse-unary p))
(set! lookahead (peek p))
(let loop ()
(when (or (> (precedence lookahead) (precedence operator))
(and (right-assoc? lookahead)
(= (precedence lookahead) (precedence operator))))
(set! rhs (parse-expr p rhs (precedence lookahead)))
(set! lookahead (peek p))
(loop)))
(set! lhs (binary (token-typ operator)
lhs rhs))
(loop lookahead)))
lhs)
(define (parse-unary p)
(define tok (peek p))
(case (token-typ tok)
[(number) (take p)
(string->number (token-val tok))]
[(true) (take p)
'true]
[(false) (take p)
'false]
[(identifier) (take p)
(token-val tok)]
[else (error 'unknown "~a" tok)]))