blob: e1a4f6ea319cbc7d2c17ce90522bc6a7f65402da (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
(define-module (modules lexer driver)
#:export (read-tokens))
(define (read-tokens)
"Returns a stream of tokens from the
current input port."
(define (read-tokens-loop tokens-so-far)
(let ((token (read-token)))
(if token
(read-tokens-loop (cons token tokens-so-far))
(reverse tokens-so-far))))
(read-tokens-loop '()))
(define (read-token)
(let ((chr (read-char)))
(cond
((eof-object? chr) #f)
((char-whitespace? chr)
(read-token))
((eqv? chr #\()
'left-paren)
((eqv? chr #\))
'right-paren)
((eqv? chr #\{)
'open-brace)
((eqv? chr #\})
'close-brace)
((eqv? chr #\;)
'semi-colon)
((eqv? chr #\~)
'not)
((eqv? chr #\+)
(if (take-double? chr)
'++
'+))
((eqv? chr #\-)
(if (take-double? chr)
'--
'neg))
((char-numeric? chr)
(read-constant chr))
((char-alphabetic? chr)
(lookup-keyword (read-identifier chr)))
(#t (error "illegal lexical syntax")))))
(define (read-constant chr)
(define (read-constant-helper chrs-so-far)
(let ((chr (peek-char)))
(cond ((and (not (eof-object? chr)) (char-numeric? chr))
(read-constant-helper (cons (read-char) chrs-so-far)))
((and (not (eof-object? chr)) (char-alphabetic? chr))
(error "identifier starting with digit"))
(#t (reverse chrs-so-far)))))
(string->number (list->string (read-constant-helper (list chr)))))
(define (read-identifier chr)
(define (read-identifier-helper chrs-so-far)
(let ((chr (peek-char)))
(cond ((and (not (eof-object? chr))
(or (char-alphabetic? chr)
(char-numeric? chr)
(eqv? chr #\_)))
(read-identifier-helper (cons (read-char) chrs-so-far)))
(#t (reverse chrs-so-far)))))
(list->string (read-identifier-helper (list chr))))
(define (take-double? chr)
(if (eqv? chr (peek-char))
(read-char)
#f))
(define (lookup-keyword id)
"Given identifier ID, converts it to a keyword
if one is known."
(let ((found (assoc
id
'(("int" . int)
("void" . void)
("return" . return)))))
(if found (cdr found) id)))
|
