102 lines
2.6 KiB
Scheme
102 lines
2.6 KiB
Scheme
(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))
|