Files
scheme-fudge/lexer.sld

73 lines
1.9 KiB
Scheme

(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))))))