(import (rnrs)) (define get-word (lambda (file) (let ([c (lookahead-char file)]) (cond [(eof-object? c) ""] [(char-alphabetic? c) (get-char file) (string-append (string c) (get-word file))] [else ""])))) (define char->digit (lambda (c) (- (char->integer c) (char->integer #\0)))) ; get-number supports only nonnegative integers. (define get-number (lambda (file) (let f ([total 0]) (let ([c (lookahead-char file)]) (if (char-numeric? c) (begin (get-char file) (f (+ (* total 10) (char->digit c)))) total))))) (define get-token (lambda (file) (let ([c (lookahead-char file)]) (cond [(eof-object? c) 'end-of-file] [(char-whitespace? c) (get-char file) (get-token file)] [(char-alphabetic? c) (get-word file)] [(char-numeric? c) (get-number file)] [(eq? c #\+) (get-char file) '+] [(eq? c #\-) (get-char file) '-] [(eq? c #\*) (get-char file) '*] [(eq? c #\/) (get-char file) '/] [(eq? c #\=) (get-char file) #\=] [else (error 'get-token "Bad character" c)])))) (define get-tokens (lambda (file) (let ([token (get-token file)]) (if (eq? token 'end-of-file) '() (cons token (get-tokens file)))))) (define tokenize (lambda (filename) (let ([file (open-input-file filename)]) (get-tokens file)))) (define test-lexer-fail (lambda (input want got) (display "text-lexer-fail: input=") (write input) (display "; want: ") (write want) (display "; got: ") (write got) (display ".") (newline))) (define test-lexer-success (lambda (input got) (display "text-lexer-success: input=") (write input) (display "; got: ") (write got) (display ".") (newline))) (define test-lexer (lambda (input want) (let ([port (open-string-input-port input)]) (call/cc (lambda (i-got-exception) (with-exception-handler (lambda (x) (display "test-lexer-fail: input ") (write input) (display " throws ") (write x) (display ".") (newline) (i-got-exception x)) (lambda () (let ([got (get-tokens port)]) (if (equal? got want) (test-lexer-success input got) (test-lexer-fail input want got)))))))))) (test-lexer "hello world" '("hello" "world")) (test-lexer "+ * / -" '(+ * / -)) (test-lexer "identifier = 14" '("identifier" = 14))