blob: 6547a79539719eb21566db496afb9037f60d7ed1 (
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
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
require types.fs
require printer.fs
\ Drop a char off the front of string by advancing the addr and
\ decrementing the length, and fetch next char
: adv-str ( str-addr str-len -- str-addr str-len char )
swap 1+ swap 1-
dup 0= if 0 ( eof )
else over c@ endif ;
: mal-digit? ( char -- flag )
dup [char] 9 <= if
[char] 0 >=
else
drop 0
endif ;
: char-in-str? ( char str-addr str-len )
rot { needle }
false -rot
over + swap ?do
i c@ needle = if drop true leave endif
loop ;
: sym-char? ( char -- flag )
s\" \n\r\t\000[]{}()'\"`,; " char-in-str? 0= ;
: skip-spaces ( str-addr str-len char -- str-addr str-len non-space-char )
begin
begin
dup s\" \n\r\t, " char-in-str?
while ( str-addr str-len space-char )
drop adv-str
repeat
dup [char] ; = if
drop
begin
adv-str s\" \n\r\000" char-in-str?
until
adv-str false
else
true
endif
until ;
defer read-form ( str-addr str-len -- str-addr str-len mal-obj )
: read-int ( str-addr str-len digit-char -- str-addr str-len non-digit-char mal-int )
0 { int }
begin ( str-addr str-len digit-char )
[char] 0 - int 10 * + to int ( str-addr str-len )
adv-str dup mal-digit? 0= ( str-addr str-len digit-char )
until
int MalInt. ;
: read-symbol-str ( str-addr str-len sym-char -- str-addr str-len char sym-addr sym-len )
new-str { sym-addr sym-len }
begin ( str-addr str-len sym-char )
sym-addr sym-len rot str-append-char to sym-len to sym-addr
adv-str dup sym-char? 0=
until
sym-addr sym-len ;
: read-string-literal ( in-addr in-len quote-char -- in-addr in-len mal-string )
new-str { out-addr out-len }
drop \ drop leading quote
begin ( in-addr in-len )
adv-str over 0= if
2drop s\" expected '\"', got EOF\n" safe-type 1 throw
endif
dup [char] " <>
while
dup [char] \ = if
drop adv-str
dup [char] n = if drop 10 endif
dup [char] r = if drop 13 endif
endif
out-addr out-len rot str-append-char to out-len to out-addr
repeat
drop adv-str \ skip trailing quote
out-addr out-len MalString. ;
: read-list ( str-addr str-len open-paren-char close-paren-char
-- str-addr str-len non-paren-char mal-list )
here { close-char old-here }
drop adv-str
begin ( str-addr str-len char )
skip-spaces ( str-addr str-len non-space-char )
over 0= if
drop 2drop
s\" expected '" close-char str-append-char
s\" ', got EOF" str-append safe-type 1 throw
endif
dup close-char <>
while ( str-addr str-len non-space-non-paren-char )
read-form ,
repeat
drop adv-str
old-here here>MalList ;
: read-wrapped ( buf-addr buf-len quote-char sym-addr sym-len -- buf-addr buf-len char mal-list )
here { old-here }
MalSymbol. , ( buf-addr buf-len char )
read-form , ( buf-addr buf-len char )
old-here here>MalList ;
: read-form2 ( str-addr str-len char -- str-addr str-len char mal-obj )
skip-spaces
dup mal-digit? if read-int else
dup [char] ( = if [char] ) read-list else
dup [char] [ = if [char] ] read-list MalVector new tuck MalVector/list ! else
dup [char] { = if [char] } read-list MalMap new tuck MalMap/list ! else
dup [char] " = if read-string-literal else
dup [char] : = if drop adv-str read-symbol-str MalKeyword. else
dup [char] @ = if drop adv-str s" deref" read-wrapped else
dup [char] ' = if drop adv-str s" quote" read-wrapped else
dup [char] ` = if drop adv-str s" quasiquote" read-wrapped else
dup [char] ~ = if
drop adv-str
dup [char] @ = if drop adv-str s" splice-unquote" read-wrapped
else s" unquote" read-wrapped
endif
else
dup [char] ^ = if
drop adv-str
read-form { meta } read-form { obj }
meta mal-nil conj
obj swap conj
s" with-meta" MalSymbol. swap conj
else
read-symbol-str
2dup s" true" str= if 2drop mal-true
else 2dup s" false" str= if 2drop mal-false
else 2dup s" nil" str= if 2drop mal-nil
else
MalSymbol.
endif endif endif endif endif endif endif endif endif endif endif endif endif endif ;
' read-form2 is read-form
: read-str ( str-addr str-len - mal-obj )
over c@ read-form { obj } drop 2drop obj ;
|
