141 lines
3.7 KiB
Scheme
Executable File
141 lines
3.7 KiB
Scheme
Executable File
(import (scheme base)
|
|
(scheme file)
|
|
(scheme write)
|
|
(scheme char))
|
|
|
|
(define-syntax import-scheme
|
|
(syntax-rules ()
|
|
((_ module ...)
|
|
(import (scheme module) ...))))
|
|
|
|
(define keywords
|
|
'("true" "false" "struct" "enum" "if" "then" "else" "type" "let"))
|
|
|
|
(define keyword?
|
|
(lambda (word)
|
|
(member word keywords)))
|
|
|
|
(define get-word-string
|
|
(lambda (file)
|
|
(let ((c (peek-char file)))
|
|
(cond
|
|
((eof-object? c) "")
|
|
((char-alphabetic? c)
|
|
(read-char file)
|
|
(string-append (string c) (get-word file)))
|
|
(else "")))))
|
|
|
|
(define get-word
|
|
(lambda (file)
|
|
(let ((word (get-word-string file)))
|
|
(if (keyword? word)
|
|
(string->symbol word)
|
|
word))))
|
|
|
|
(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 (peek-char file)))
|
|
(cond
|
|
((eof-object? c) total)
|
|
((char-numeric? c)
|
|
(read-char file)
|
|
(f (+ (* total 10) (char->digit c))))
|
|
(else total))))))
|
|
|
|
(define get-token
|
|
(lambda (file)
|
|
(let ((c (peek-char file)))
|
|
(cond
|
|
((eof-object? c) 'end-of-file)
|
|
((char-whitespace? c)
|
|
(read-char file)
|
|
(get-token file))
|
|
((char-alphabetic? c)
|
|
(get-word file))
|
|
((char-numeric? c)
|
|
(get-number file))
|
|
((eq? c #\+) (read-char file) '+)
|
|
((eq? c #\-) (read-char file) '-)
|
|
((eq? c #\*) (read-char file) '*)
|
|
((eq? c #\/) (read-char file) '/)
|
|
((eq? c #\=) (read-char file) '=)
|
|
((eq? c #\() (read-char file) 'left-parenthesis)
|
|
((eq? c #\)) (read-char file) 'right-parenthesis)
|
|
((eq? c #\{) (read-char file) 'left-brace)
|
|
((eq? c #\}) (read-char file) 'right-brace)
|
|
((eq? c #\;) (read-char file) 'semicolon)
|
|
((eq? c #\:) (read-char file) 'colon)
|
|
(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-fail-exception
|
|
(lambda (input x)
|
|
(display "test-lexer-fail: input ")
|
|
(write input)
|
|
(display " throws ")
|
|
(write (error-object-message x))
|
|
(display ".")
|
|
(newline)))
|
|
|
|
(define test-lexer
|
|
(lambda (input want)
|
|
(let ((port (open-input-string input)))
|
|
(call/cc
|
|
(lambda (i-got-exception)
|
|
(with-exception-handler
|
|
(lambda (x)
|
|
(test-lexer-fail-exception input x)
|
|
(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 "( ) { }" '(left-parenthesis right-parenthesis left-brace right-brace))
|
|
(test-lexer "true false" '(true false))
|
|
(test-lexer "if then else" '(if then else))
|
|
(test-lexer ": ;" '(colon semicolon))
|
|
(test-lexer "identifier = 14" '("identifier" = 14))
|
|
(test-lexer "" '())
|