73 lines
1.9 KiB
Plaintext
73 lines
1.9 KiB
Plaintext
|
(define-library (lexer)
|
||
|
|
(export tokenize)
|
||
|
|
(import (scheme base)
|
||
|
|
(scheme write)
|
||
|
|
(scheme char))
|
||
|
|
(begin
|
||
|
|
(define-record-type lexer
|
||
|
|
(make-lexer-with-index input index)
|
||
|
|
lexer?
|
||
|
|
(input lexer-input lexer-input-set!)
|
||
|
|
(index lexer-index lexer-index-set!))
|
||
|
|
|
||
|
|
(define-record-type lexer-error
|
||
|
|
(make-lexer-error type message)
|
||
|
|
lexer-error?
|
||
|
|
(type lexer-error-type)
|
||
|
|
(message lexer-error-message)
|
||
|
|
))
|
||
|
|
|
||
|
|
(define make-lexer
|
||
|
|
(lambda (input)
|
||
|
|
(make-lexer-with-index input 0)))
|
||
|
|
|
||
|
|
(define lexer-end?
|
||
|
|
(lambda (lexer)
|
||
|
|
(>= (lexer-index lexer)
|
||
|
|
(string-length (lexer-input lexer)))))
|
||
|
|
|
||
|
|
(define lexer-peek
|
||
|
|
(lambda (lexer)
|
||
|
|
(if (lexer-end? lexer)
|
||
|
|
(eof-object)
|
||
|
|
(string-ref (lexer-input lexer)
|
||
|
|
(lexer-index lexer)))))
|
||
|
|
|
||
|
|
(define lexer-eat!
|
||
|
|
(lambda (lexer)
|
||
|
|
(if (lexer-end? lexer)
|
||
|
|
(eof-object)
|
||
|
|
(let ((index (lexer-index lexer)))
|
||
|
|
(lexer-index-set! lexer (+ index 1))
|
||
|
|
(string-ref (lexer-input lexer) index)))))
|
||
|
|
|
||
|
|
(define get-token
|
||
|
|
(lambda (lexer)
|
||
|
|
(let ((c (lexer-peek lexer)))
|
||
|
|
(cond
|
||
|
|
((eof-object? c) "")
|
||
|
|
((char-alphabetic? c)
|
||
|
|
(lexer-eat! lexer)
|
||
|
|
(string-append (string c) (get-token lexer)))
|
||
|
|
(else "")))))
|
||
|
|
|
||
|
|
(define get-tokens
|
||
|
|
(lambda (lexer)
|
||
|
|
(let loop ((tokens #()))
|
||
|
|
(let ((c (lexer-peek lexer)))
|
||
|
|
(cond
|
||
|
|
((eof-object? c) tokens)
|
||
|
|
((char-whitespace? c)
|
||
|
|
(lexer-eat! lexer)
|
||
|
|
(loop tokens))
|
||
|
|
((char-alphabetic? c)
|
||
|
|
(let ((token (get-token lexer)))
|
||
|
|
(if (lexer-error? token)
|
||
|
|
token
|
||
|
|
(loop )))))))
|
||
|
|
|
||
|
|
|
||
|
|
(define tokenize
|
||
|
|
(lambda (input)
|
||
|
|
(get-tokens (make-lexer input))))))
|