Commit | Line | Data |
---|---|---|
ea81a808 JM |
1 | % General functions |
2 | ||
1b4a9012 | 3 | % concatenate: concatenate two strings or two arrays |
e7c1a2f6 | 4 | % From Thinking in PostScript 1990 Reid, Example 11.7 |
1b4a9012 JM |
5 | % (string1) (string2) concatenate string3 |
6 | % array1 array2 concatenate array3 | |
7 | /concatenate { %def | |
8 | dup type 2 index type 2 copy ne { %if | |
9 | pop pop | |
950e3c76 | 10 | errordict begin (concatenate) typecheck end |
1b4a9012 JM |
11 | }{ %else |
12 | /stringtype ne exch /arraytype ne and { | |
13 | errordict begin (concatenate) typecheck end | |
14 | } if | |
15 | } ifelse | |
16 | dup length 2 index length add 1 index type | |
17 | /arraytype eq { array }{ string } ifelse | |
18 | % stack: arg1 arg2 new | |
19 | dup 0 4 index putinterval | |
20 | % stack: arg1 arg2 new | |
21 | dup 4 -1 roll length 4 -1 roll putinterval | |
22 | % stack: new | |
23 | } bind def | |
24 | ||
55e2bfa8 JM |
25 | % reverse: array1 -> reverse -> array2 |
26 | /reverse { | |
27 | [ exch | |
28 | aload % push array onto stack | |
29 | length -1 0 { 1 roll } for % reverse | |
30 | ] | |
aef93ea3 | 31 | } bind def |
55e2bfa8 | 32 | |
e7c1a2f6 JM |
33 | % string1 string2 string3 -> replace -> string4 |
34 | % Return a string4 with all occurrences of string2 in string1 replaced | |
35 | % with string3 | |
36 | /replace { 4 dict begin | |
37 | /repstr exch def | |
38 | /needle exch def | |
39 | /haystack exch def | |
40 | /result () def | |
41 | { % loop | |
42 | haystack needle search | |
43 | { %if found | |
44 | % stack: post match pre | |
45 | repstr concatenate 3 1 roll pop % stack: pre+ post | |
46 | /haystack exch def % stack: pre+ | |
47 | result exch concatenate /result exch def | |
48 | }{ | |
49 | result exch concatenate /result exch def | |
50 | exit | |
51 | } ifelse | |
52 | } loop | |
53 | result | |
54 | end } def | |
55 | ||
56 | ||
0a2c6954 JM |
57 | % objA objB -> _equal? -> bool |
58 | /_equal? { 6 dict begin | |
59 | /b exch def | |
60 | /a exch def | |
0a2c6954 JM |
61 | |
62 | a type b type eq | |
5ce65382 | 63 | a _sequential? b _sequential? and |
0a2c6954 JM |
64 | or not { %if type mismatch and not sequential |
65 | false | |
66 | }{ | |
798cd0a0 | 67 | a _sequential? b _sequential? and { %if list/vector |
0a2c6954 | 68 | /ret true def |
5ce65382 | 69 | a _count b _count eq not { %if length mismatch |
0a2c6954 JM |
70 | /ret false def |
71 | }{ %else (length is the same) | |
5ce65382 | 72 | 0 1 a _count 1 sub { |
0a2c6954 | 73 | /idx exch def |
5ce65382 | 74 | a idx _nth b idx _nth _equal? not { %if not items _equal? |
0a2c6954 JM |
75 | /ret false def |
76 | exit | |
77 | } if | |
78 | } for | |
79 | } ifelse | |
80 | ret | |
798cd0a0 DM |
81 | }{ %else not list/vector |
82 | a _hash_map? b _hash_map? and { %if hash_map | |
83 | /ret true def | |
84 | /a_keys a _keys def | |
85 | a_keys _count b _keys _count eq not { | |
86 | /ret false def | |
87 | }{ | |
88 | a_keys /data get { %foreach key in a_keys | |
89 | /key exch def | |
90 | a key _hash_map_get b key _hash_map_get _equal? not { %if not items _equal? | |
91 | /ret false def | |
92 | exit | |
93 | } if | |
94 | } forall | |
95 | } ifelse | |
96 | ret | |
97 | }{ %else not hash_map | |
98 | a b eq | |
99 | } ifelse | |
0a2c6954 JM |
100 | } ifelse |
101 | } ifelse | |
102 | end } def | |
103 | ||
5ce65382 JM |
104 | |
105 | % Low-level sequence operations | |
106 | ||
107 | /_sequential? { dup _list? exch _vector? or } def | |
108 | ||
109 | /_count { /data get length } def | |
950e3c76 | 110 | |
ea81a808 | 111 | /_first { |
5ce65382 | 112 | /data get |
ea81a808 | 113 | dup length 0 gt { 0 get }{ pop null } ifelse |
8e7e339d | 114 | } def |
5ce65382 JM |
115 | |
116 | % seq start count -> _slice -> new_seq | |
117 | /_slice { | |
118 | 3 -1 roll /data get 3 1 roll % stack: array start count | |
119 | getinterval | |
120 | _list_from_array | |
121 | } def | |
122 | ||
123 | % seq idx -> _nth -> ith_item | |
124 | /_nth { | |
125 | exch /data get % stack: idx array | |
126 | dup length 0 gt { exch get }{ pop pop null } ifelse | |
127 | } def | |
128 | ||
129 | % seq -> _rest -> rest_seq | |
ea81a808 | 130 | /_rest { |
5ce65382 | 131 | /data get |
ea81a808 JM |
132 | dup length 0 gt { |
133 | dup length 1 sub 1 exch getinterval | |
3da90d39 | 134 | }{ |
ea81a808 | 135 | pop 0 array |
3da90d39 | 136 | } ifelse |
5ce65382 | 137 | _list_from_array |
3da90d39 JM |
138 | } def |
139 | ||
798cd0a0 DM |
140 | % hashmap -> _keys -> key_list |
141 | /_keys { | |
142 | /data get | |
143 | [ exch { pop dup length string cvs } forall ] | |
144 | _list_from_array | |
145 | } def | |
146 | ||
147 | % hashmap key -> _hash_map_get -> val | |
148 | /_hash_map_get { | |
149 | exch % stack: key hashmap | |
150 | /data get % stack: key dict | |
151 | exch % stack: dict key | |
152 | 2 copy known { %if has key | |
153 | get | |
154 | }{ | |
155 | pop pop null | |
156 | } ifelse | |
157 | } def | |
aef93ea3 | 158 | |
950e3c76 | 159 | |
8e7e339d | 160 | % Errors/Exceptions |
1b4a9012 | 161 | |
5ce65382 JM |
162 | % data -> _throw -> |
163 | % Takes arbitrary data and puts it in $error:/errorinfo. Then calls | |
164 | % stop to transfer control to end of nearest stopped context. | |
165 | /_throw { | |
166 | $error exch /errorinfo exch put | |
167 | $error /command /throw put | |
168 | stop | |
169 | } def | |
170 | ||
aef93ea3 JM |
171 | /errorinfo? { |
172 | $error /errorinfo known { % if set | |
173 | $error /errorinfo get null ne { | |
174 | true | |
175 | }{ | |
176 | false | |
177 | } ifelse | |
178 | }{ | |
179 | false | |
180 | } ifelse | |
1b4a9012 | 181 | } def |
04517bc8 | 182 | |
aef93ea3 JM |
183 | /get_error_data { |
184 | errorinfo? { %if | |
185 | $error /errorinfo get | |
186 | }{ | |
187 | $error /errorname get 255 string cvs | |
188 | (: ) | |
189 | $error /command get 99 string cvs | |
190 | ( at ) | |
191 | $error /position get 10 99 string cvrs | |
192 | concatenate | |
193 | concatenate | |
194 | concatenate | |
195 | concatenate | |
196 | } ifelse | |
197 | } def | |
04517bc8 | 198 | |
aef93ea3 | 199 | |
ea81a808 | 200 | % Scalars |
aef93ea3 | 201 | |
ea81a808 JM |
202 | /_nil? { null eq } def |
203 | /_true? { true eq } def | |
204 | /_false? { false eq } def | |
04517bc8 | 205 | |
8e7e339d | 206 | |
ea81a808 | 207 | % Symbols |
950e3c76 | 208 | |
b8ee29b2 JM |
209 | /_symbol { |
210 | dup length string copy cvn | |
211 | } def | |
212 | ||
ea81a808 JM |
213 | /_symbol? { |
214 | type /nametype eq | |
8e7e339d JM |
215 | } def |
216 | ||
950e3c76 | 217 | |
b8ee29b2 JM |
218 | % Keywords |
219 | ||
220 | /_keyword { 1 dict begin | |
221 | /str exch def | |
222 | str length 1 add string % str2 | |
223 | dup 1 str putinterval | |
224 | dup 0 127 put % TODO: something like (\x029e) would be better | |
225 | end } def | |
226 | ||
227 | /_keyword? { | |
228 | dup type /stringtype eq { | |
229 | 0 get 127 eq | |
230 | }{ | |
406761e7 | 231 | pop false |
b8ee29b2 JM |
232 | } ifelse |
233 | } def | |
234 | ||
235 | ||
236 | ||
ea81a808 | 237 | % Functions |
950e3c76 | 238 | |
0027e8fe JM |
239 | % block -> _function -> boxed_function |
240 | /_function { | |
241 | << | |
242 | /_maltype_ /function | |
243 | %/data 5 -1 roll cvlit | |
244 | /data 5 -1 roll | |
245 | >> | |
246 | %%dup length dict copy | |
247 | } def | |
248 | ||
249 | % ast env params -> _mal_function -> boxed_mal_function | |
250 | /_mal_function { | |
251 | << | |
252 | /_maltype_ /mal_function % user defined function | |
253 | /macro? false % macro flag, false by default | |
254 | /params null % close over parameters | |
255 | /ast null % close over ast | |
256 | /env null % close over environment | |
257 | /data { __self__ fload EVAL } % forward reference to EVAL | |
258 | dup length array copy cvx % actual copy/new instance of block | |
259 | >> | |
260 | % make an actual copy/new instance of dict | |
261 | dup length dict copy % stack: ast env params mal_fn | |
262 | % "Close over" parameters | |
263 | dup 3 -1 roll % stack: ast env mal_fn mal_fn params | |
264 | /params exch put % stack: ast env mal_fn | |
265 | dup 3 -1 roll % stack: ast mal_fn mal_fn env | |
266 | /env exch put % stack: ast mal_fn | |
267 | dup 3 -1 roll % stack: mal_fn mal_fn ast | |
268 | /ast exch put % stack: mal_fn | |
269 | ||
270 | % insert self reference into position 0 of data | |
271 | dup /data get % stack: mal_fn data | |
272 | 1 index % stack: mal_fn data mal_fn | |
273 | 0 exch % stack: mal_fn data 0 mal_fn | |
274 | put % stack: mal_fn | |
275 | } def | |
276 | ||
277 | /_function? { | |
ea81a808 | 278 | dup type /dicttype eq { |
5ce65382 | 279 | /_maltype_ get /function eq |
ea81a808 JM |
280 | }{ |
281 | pop false | |
282 | } ifelse | |
283 | } def | |
950e3c76 | 284 | |
0027e8fe JM |
285 | /_mal_function? { |
286 | dup type /dicttype eq { | |
287 | /_maltype_ get /mal_function eq | |
288 | }{ | |
289 | pop false | |
290 | } ifelse | |
291 | } def | |
292 | ||
ea81a808 JM |
293 | % args mal_function -> fload -> ast new_env |
294 | % fload: sets up arguments on the stack for an EVAL call | |
295 | /fload { | |
296 | dup /ast get 3 1 roll % stack: ast args mal_function | |
297 | dup /env get 3 1 roll % stack: ast env args mal_function | |
298 | /params get exch % stack: ast env params args | |
299 | env_new % stack: ast new_env | |
300 | } def | |
04517bc8 | 301 | |
0027e8fe JM |
302 | % function_or_mal_function -> callable -> block |
303 | % if this is a function or mal_function, get its executable block | |
304 | /callable { | |
305 | dup _mal_function? { %if mal_function | |
306 | /data get | |
307 | }{ dup _function? { %else if function | |
308 | /data get | |
309 | }{ %else something invalid | |
310 | (callable called on non-function!\n) print quit | |
311 | cvx | |
312 | } ifelse } ifelse | |
313 | } def | |
04517bc8 | 314 | |
04517bc8 | 315 | |
ea81a808 | 316 | % Lists |
04517bc8 | 317 | |
5ce65382 JM |
318 | % array -> _list_from_array -> mal_list |
319 | /_list_from_array { | |
320 | << | |
321 | /data 3 -1 roll % grab the array argument | |
322 | /_maltype_ /list | |
323 | /meta null | |
324 | >> | |
325 | } def | |
326 | % elem... cnt -> _list -> mal_list | |
ea81a808 | 327 | /_list { |
5ce65382 | 328 | array astore _list_from_array |
ea81a808 JM |
329 | } def |
330 | /_list? { | |
5ce65382 JM |
331 | dup type /dicttype eq { |
332 | /_maltype_ get /list eq | |
333 | }{ | |
334 | pop false | |
335 | } ifelse | |
336 | } def | |
337 | ||
338 | ||
339 | % Vectors | |
340 | ||
341 | % array -> _vector_from_array -> mal_vector | |
342 | /_vector_from_array { | |
343 | << | |
344 | /data 3 -1 roll % grab the array argument | |
345 | /_maltype_ /vector | |
346 | /meta null | |
347 | >> | |
348 | } def | |
349 | % elem... cnt -> _vector -> mal_vector | |
350 | /_vector { | |
351 | array astore _vector_from_array | |
352 | } def | |
353 | /_vector? { | |
354 | dup type /dicttype eq { | |
355 | /_maltype_ get /vector eq | |
356 | }{ | |
357 | pop false | |
358 | } ifelse | |
359 | } def | |
360 | ||
361 | ||
362 | % Hash Maps | |
363 | ||
364 | % dict -> _hash_map_from_dict -> mal_hash_map | |
365 | /_hash_map_from_dict { | |
366 | << | |
367 | /data 3 -1 roll | |
368 | /_maltype_ /hash_map | |
369 | /meta null | |
370 | >> | |
371 | } def | |
372 | % array -> _hash_map_from_array -> mal_hash_map | |
373 | /_hash_map_from_array { | |
374 | << | |
375 | /data << | |
376 | 4 -1 roll % grab the array argument | |
377 | aload pop % unpack the array | |
378 | >> | |
379 | /_maltype_ /hash_map | |
380 | /meta null | |
381 | >> | |
382 | } def | |
383 | % elem... cnt -> _hash_map -> mal_hash_map | |
384 | /_hash_map { | |
385 | array astore _hash_map_from_array | |
386 | } def | |
387 | /_hash_map? { | |
388 | dup type /dicttype eq { | |
389 | /_maltype_ get /hash_map eq | |
390 | }{ | |
391 | pop false | |
392 | } ifelse | |
ea81a808 | 393 | } def |
0a2c6954 | 394 | |
5ce65382 JM |
395 | |
396 | % Atoms | |
397 | ||
398 | % obj -> atom -> new_atom | |
399 | /_atom { | |
400 | << | |
401 | /data 3 -1 roll | |
402 | /_maltype_ /atom | |
403 | /meta null | |
404 | >> | |
405 | } def | |
406 | ||
407 | /_atom? { | |
408 | dup type /dicttype eq { | |
409 | /_maltype_ get /atom eq | |
410 | }{ | |
411 | pop false | |
412 | } ifelse | |
413 | } def | |
414 | ||
415 | ||
416 | ||
417 | % Sequence operations |