Commit | Line | Data |
---|---|---|
1b4a9012 JM |
1 | (in reader\n) print |
2 | ||
3 | ||
4 | /token_delim (;,"` \n{}\(\)[]) def | |
5 | /token_number (0123456789-) def | |
6 | ||
7 | % read_number: read a single number from string/idx | |
8 | % string idx -> read_number -> number string new_idx | |
9 | /read_number { | |
10 | %(in read_number\n) print | |
11 | /idx exch def | |
12 | /str exch def | |
13 | /start idx def | |
14 | /cnt 0 def | |
15 | { % loop | |
16 | idx str length ge { exit } if % EOF, break loop | |
17 | /ch str idx get def % current character | |
18 | ch 48 ge ch 57 le and 45 ch eq or { %if number | |
19 | /cnt cnt 1 add def | |
20 | }{ % else | |
21 | exit | |
22 | } ifelse | |
23 | /idx idx 1 add def % increment idx | |
24 | } loop | |
25 | ||
26 | str start cnt getinterval cvi % the matched number | |
27 | str idx % return: number string new_idx | |
28 | } def | |
29 | ||
30 | ||
31 | % read_symbol: read a single symbol from string/idx | |
32 | % string idx -> read_symbol -> name string new_idx | |
33 | /read_symbol { | |
34 | %(in read_symbol\n) print | |
35 | /idx exch def | |
36 | /str exch def | |
37 | /start idx def | |
38 | /cnt 0 def | |
39 | { % loop | |
40 | idx str length ge { exit } if % EOF, break loop | |
41 | /ch str idx 1 getinterval def | |
42 | token_delim ch search { % if token delimeter | |
43 | pop pop pop exit | |
44 | }{ % else not a delim | |
45 | pop | |
46 | /cnt cnt 1 add def | |
47 | } ifelse | |
48 | /idx idx 1 add def % increment idx | |
49 | } loop | |
50 | ||
51 | str start cnt getinterval cvn % the matched symbol | |
52 | str idx % return: symbol string new_idx | |
53 | } def | |
54 | ||
55 | ||
56 | % read_string: read a single string from string/idx | |
57 | % string idx -> read_string -> new_string string new_idx | |
58 | /read_string { | |
59 | %(in read_string\n) print | |
60 | /idx exch 1 add def | |
61 | /str exch def | |
62 | /start idx def | |
63 | /cnt 0 def | |
64 | { % loop | |
65 | idx str length ge { %if EOF | |
aef93ea3 JM |
66 | (unexpected EOF reading string) |
67 | throw | |
1b4a9012 JM |
68 | } if |
69 | /ch str idx get def % current character | |
70 | /idx idx 1 add def | |
71 | ch 34 eq { exit } if % '"' is end of string | |
72 | /cnt cnt 1 add def | |
73 | } loop | |
74 | str start cnt getinterval % the matched string | |
75 | str idx % return: new_string string new_idx | |
76 | } def | |
77 | ||
78 | ||
79 | % read_atom: read a single atom from string/idx | |
80 | % string idx -> read_atom -> int string new_idx | |
81 | /read_atom { | |
82 | %(in read_atom\n) print | |
83 | /idx exch def | |
84 | /str exch def | |
85 | str length idx le { % ifelse | |
86 | exit % EOF | |
87 | }{ | |
88 | /ch str idx get def % current character | |
55e2bfa8 JM |
89 | %ch 48 ge ch 57 le and 45 ch eq or { %if number |
90 | ch 48 ge ch 57 le and { %if number | |
1b4a9012 JM |
91 | str idx read_number |
92 | }{ ch 34 eq { %elseif double-quote | |
93 | str idx read_string | |
94 | }{ | |
95 | str idx read_symbol | |
96 | /idx exch def pop | |
97 | dup /nil eq { %if nil | |
98 | pop null str idx | |
99 | }{ dup /true eq { %elseif true | |
100 | pop true str idx | |
101 | }{ dup /false eq { %elseif false | |
102 | pop false str idx | |
103 | }{ %else | |
104 | str idx % return the original symbol/name | |
105 | } ifelse } ifelse } ifelse | |
106 | } ifelse } ifelse | |
107 | }ifelse | |
108 | ||
109 | % return: atom string new_idx | |
110 | } def | |
111 | ||
112 | % read_list: read a single list from string/idx | |
113 | % string idx -> read_list -> list string new_idx | |
114 | /read_list { | |
115 | %(in read_list\n) print | |
116 | /idx exch 1 add def | |
117 | /str exch def | |
118 | [ | |
119 | { % loop | |
120 | str idx read_spaces /idx exch def pop | |
121 | str length idx le { %if EOF | |
aef93ea3 JM |
122 | (unexpected EOF reading list) |
123 | throw | |
1b4a9012 JM |
124 | } if |
125 | /ch str idx get def % current character | |
126 | ch 41 eq { exit } if % ')' is end of list | |
127 | str idx read_form /idx exch def pop | |
128 | } loop | |
129 | ] | |
130 | str idx 1 add | |
131 | } def | |
132 | ||
133 | % read_spaces: advance idx to the first non-whitespace | |
134 | % string idx -> read_form -> string new_idx | |
135 | /read_spaces { | |
136 | %(in read_spaces\n) print | |
137 | /idx exch def | |
138 | /str exch def | |
139 | { % loop | |
140 | str length idx le { exit } if % EOF, break loop | |
141 | /ch str idx get def % current character | |
142 | % if not whitespace then exit | |
143 | ch 32 ne ch 10 ne ch 44 ne and and { exit } if | |
144 | /idx idx 1 add def % increment idx | |
145 | } loop | |
146 | ||
147 | str idx % return: string new_idx | |
148 | } def | |
149 | ||
150 | % read_form: read the next form from string start at idx | |
151 | % string idx -> read_form -> ast string new_idx | |
8e7e339d | 152 | /read_form { 3 dict begin |
1b4a9012 JM |
153 | %(in read_form\n) print |
154 | read_spaces | |
155 | /idx exch def | |
156 | /str exch def | |
157 | ||
158 | idx str length ge { exit } if % EOF, break loop | |
159 | /ch str idx get def % current character | |
8e7e339d JM |
160 | ch 39 eq { %if '\'' |
161 | /idx idx 1 add def | |
162 | str idx read_form | |
163 | 3 -1 roll /quote exch 2 _list 3 1 roll | |
164 | }{ ch 96 eq { %if '`' | |
165 | /idx idx 1 add def | |
166 | str idx read_form | |
167 | 3 -1 roll /quasiquote exch 2 _list 3 1 roll | |
168 | }{ ch 126 eq { %if '~' | |
169 | /idx idx 1 add def | |
170 | /ch str idx get def % current character | |
171 | ch 64 eq { %if '~@' | |
172 | /idx idx 1 add def | |
173 | str idx read_form | |
174 | 3 -1 roll /splice-unquote exch 2 _list 3 1 roll | |
175 | }{ %else just '~' | |
176 | str idx read_form | |
177 | 3 -1 roll /unquote exch 2 _list 3 1 roll | |
178 | } ifelse | |
179 | }{ ch 40 eq { %if '(' | |
1b4a9012 | 180 | str idx read_list |
8e7e339d JM |
181 | }{ ch 41 eq { %elseif ')' |
182 | (unexpected '\)') throw | |
183 | }{ ch 91 eq { %elseif '[' | |
aef93ea3 | 184 | (unexpected '[') throw |
8e7e339d | 185 | }{ ch 93 eq { %elseif ']' |
aef93ea3 | 186 | (unexpected ']') throw |
950e3c76 JM |
187 | }{ ch 123 eq { %elseif '{' |
188 | (unexpected '{') throw | |
189 | }{ ch 125 eq { %elseif '}' | |
190 | (unexpected '}') throw | |
1b4a9012 JM |
191 | }{ % else |
192 | str idx read_atom | |
950e3c76 | 193 | } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse |
1b4a9012 JM |
194 | |
195 | % return: ast string new_idx | |
8e7e339d | 196 | end } def |
1b4a9012 JM |
197 | |
198 | % string -> read_str -> ast | |
199 | /read_str { | |
200 | %(in read_str\n) print | |
201 | 0 % current index into the string | |
202 | read_form | |
203 | ||
204 | pop pop % drop the string, idx. return: ast | |
205 | } def |