-
Notifications
You must be signed in to change notification settings - Fork 7
/
reader.scm
123 lines (110 loc) · 4.17 KB
/
reader.scm
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(define (char-left-paren? ch) (char=? ch #\())
(define (char-right-paren? ch) (char=? ch #\)))
(define (char-comment? ch) (char=? ch #\;))
(define (char-string? ch) (char=? ch #\"))
(define (char-newline? ch) (char=? ch #\newline))
(define (char-dot? ch) (char=? ch #\.))
(define (char-quote? ch) (char=? ch #\'))
(define (char-quasiquote? ch) (char=? ch #\`))
(define (char-unquote? ch) (char=? ch #\,))
(define (char-backslash? ch) (char=? ch #\\))
(define (char-character? ch) (char=? ch #\#))
(define (char-minus? ch) (char=? ch #\-))
(define (identifier-end? ch) (or (char-left-paren? ch)
(char-right-paren? ch)
(char-whitespace? ch)))
(define (read)
(read-with-char (read-char)))
(define (read-with-char ch)
(cond ((eof-object? ch) ch)
((char-left-paren? ch) (read-list))
((char-whitespace? ch) (read))
((char-comment? ch) (read-comment) (read))
((char-quote? ch) (cons 'quote (cons (read) '())))
((char-quasiquote? ch) (cons 'quasiquote (cons (read) '())))
((char-unquote? ch)
(if (char=? #\@ (peek-char))
(begin (read-char) (cons 'unquote-splicing (cons (read) '())))
(cons 'unquote (cons (read) '()))))
((char-string? ch) (read-string))
((char-character? ch) (read-char-literal))
((char-numeric? ch) (read-number ch))
((and (char-minus? ch) (char-numeric? (peek-char))) (read-number ch))
(else (read-identifier ch))))
(define (read-char-literal)
(define ch (read-char))
;(display "read-char-literal:")
;(write ch)
;(newline)
(cond ((char-backslash? ch) (read-char-backslash))
((char-left-paren? ch) (list->vector (read-list)))
(else (let ((id (symbol->string (read-identifier ch))))
(cond ((string=? id "t") #t)
((string=? id "f") #f)
(else (display "ERROR! Unknown character constant #")
(display id)
(newline)))))))
(define (read-char-backslash)
(let ((id (symbol->string (read-identifier (read-char)))))
(cond ((string=? id "newline") #\newline)
((string=? id "space") #\space)
((string=? id "tab") (integer->char 9))
((= (string-length id) 1) (car (string->list id)))
(else (display "ERROR! Unknown character constant #\\")
(display id)
(newline)))))
(define (read-comment)
(if (not (char-newline? (read-char))) (read-comment)))
(define (read-list)
(define ch (read-char))
;(display "read-list:")
;(write ch)
;(newline)
(cond ((char-right-paren? ch) '())
((and (char-dot? ch) (identifier-end? (peek-char))) (car (read-list)))
((char-whitespace? ch) (read-list))
((char-comment? ch) (read-comment) (read-list))
(else (let ((elem (read-with-char ch))) (cons elem (read-list))))))
(define (char-list->number lst)
(string->number (list->string lst)))
(define (read-number ch)
;(display "read-number:")
;(write ch)
;(newline)
(define (read-nmb)
(define peek (peek-char))
(if (char-numeric? peek)
(let ((ch (read-char))) (cons ch (read-nmb))) '()))
(char-list->number (cons ch (read-nmb))))
(define (read-identifier ch)
(define (read-id)
(if (identifier-end? (peek-char)) '()
(let ((ch (read-char))) (cons ch (read-id)))))
(string->symbol (list->string (cons ch (read-id)))))
(define (interpret-escape ch)
(cond ((char=? ch #\n) #\newline) ;\n is newline
((char=? ch #\t) (integer->char 9)) ;\t is tab
(else ch)))
(define (read-string)
;(display "read-string:")
;(newline)
(define (read-str)
(define ch (read-char))
;(display "read-str:")
;(write ch)
;(newline)
(cond ((char-backslash? ch) (let ((ch (interpret-escape (read-char)))) (cons ch (read-str))))
((char-string? ch) '())
(else (cons ch (read-str)))))
(list->string (read-str)))
(define (read-all)
(let ((datum (read)))
(if (eof-object? datum)
(begin
(display "EOF reached")
(newline))
(begin
(write datum)
(newline)
(read-all)))))
(read-all)