1 | ;;;; |
---|
2 | ;;;; genturfahi - lo la .ckim. ke pe'a jajgau ratcu ke'e genturfa'i |
---|
3 | ;;;; `-> A Scheme packrat parser. |
---|
4 | ;;;; |
---|
5 | ;;;; Copyright (c) 2010 ".alyn.post." <alyn.post@lodockikumazvati.org> |
---|
6 | ;;;; |
---|
7 | ;;;; Permission to use, copy, modify, and/or distribute this software for any |
---|
8 | ;;;; purpose with or without fee is hereby granted, provided that the above |
---|
9 | ;;;; copyright notice and this permission notice appear in all copies. |
---|
10 | ;;;; |
---|
11 | ;;;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES |
---|
12 | ;;;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF |
---|
13 | ;;;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR |
---|
14 | ;;;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES |
---|
15 | ;;;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN |
---|
16 | ;;;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
---|
17 | ;;;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
---|
18 | ;;;; |
---|
19 | |
---|
20 | ;;; |
---|
21 | ;;; nunjavni - javni generators |
---|
22 | ;;; |
---|
23 | |
---|
24 | ;; selci: parse a single specified character. |
---|
25 | ;; |
---|
26 | (define (nunjavni-lerfu lerfu #!key cmene (nastura #t) porjahe) |
---|
27 | (let ((nunvalsi-lerfu (make-nunvalsi cmene nastura porjahe))) |
---|
28 | (define (javni-lerfu porsi mapti namapti) |
---|
29 | (if (char=? lerfu (car porsi)) |
---|
30 | (mapti (cdr porsi) (nunvalsi-lerfu lerfu)) |
---|
31 | (namapti porsi))) |
---|
32 | javni-lerfu)) |
---|
33 | |
---|
34 | |
---|
35 | ;; selci: parse any single character. |
---|
36 | ;; |
---|
37 | (define (nunjavni-.* #!key cmene nastura porjahe) |
---|
38 | (let ((nunvalsi-.* (make-nunvalsi cmene nastura porjahe))) |
---|
39 | (define (javni-.* porsi mapti ignore-namapti) |
---|
40 | (mapti '(#\nul) (nunvalsi-.* (lerfu-porsi-string porsi)))) |
---|
41 | javni-.*)) |
---|
42 | |
---|
43 | (define (nunjavni-.+ #!key cmene nastura porjahe) |
---|
44 | (let ((nunvalsi-.+ (make-nunvalsi cmene nastura porjahe))) |
---|
45 | (define (javni-.+ porsi mapti namapti) |
---|
46 | (if (lerfu-porsi-fanmo? porsi) |
---|
47 | (namapti porsi) |
---|
48 | (mapti '(#\nul) (nunvalsi-.+ (lerfu-porsi-string porsi))))) |
---|
49 | javni-.+)) |
---|
50 | |
---|
51 | (define (nunjavni-.kuspe #!key cmene |
---|
52 | nastura |
---|
53 | porjahe |
---|
54 | (my 0) |
---|
55 | (ny most-positive-fixnum)) |
---|
56 | (let ((nunvalsi-.kuspe (make-nunvalsi cmene nastura porjahe)) |
---|
57 | (na-fanmo? (lambda (porsi) (not (lerfu-porsi-fanmo? porsi))))) |
---|
58 | (define (javni-.kuspe porsi mapti namapti) |
---|
59 | (define (mapti-.kuspe porsi valsi) |
---|
60 | (mapti porsi (nunvalsi-.kuspe (list->string valsi)))) |
---|
61 | |
---|
62 | (span-kuspe na-fanmo? |
---|
63 | porsi |
---|
64 | mapti-.kuspe |
---|
65 | namapti |
---|
66 | my: my |
---|
67 | ny: ny)) |
---|
68 | |
---|
69 | javni-.kuspe)) |
---|
70 | |
---|
71 | (define (nunjavni-. #!key cmene nastura porjahe) |
---|
72 | (let ((nunvalsi-. (make-nunvalsi cmene nastura porjahe))) |
---|
73 | (define (javni-. porsi mapti namapti) |
---|
74 | (if (lerfu-porsi-fanmo? porsi) |
---|
75 | (namapti porsi) |
---|
76 | (mapti (cdr porsi) (nunvalsi-. (car porsi))))) |
---|
77 | javni-.)) |
---|
78 | |
---|
79 | |
---|
80 | ;; empty-string: parse the empty string, which always succeeds without |
---|
81 | ;; advancing input. |
---|
82 | ;; |
---|
83 | (define (nunjavni-e #!key cmene (nastura #t) porjahe (empty-string "")) |
---|
84 | (let ((nunvalsi-e (make-nunvalsi cmene nastura porjahe))) |
---|
85 | (define (javni-e porsi mapti ignore-namapti) |
---|
86 | (mapti porsi (nunvalsi-e empty-string))) |
---|
87 | javni-e)) |
---|
88 | |
---|
89 | |
---|
90 | ;; empty-list: parse the empty list, which always succeeds without |
---|
91 | ;; advancing input. |
---|
92 | ;; |
---|
93 | (define (nunjavni-nil #!key cmene nastura porjahe (empty-list '())) |
---|
94 | (let ((nunvalsi-nil (make-nunvalsi cmene nastura porjahe))) |
---|
95 | (define (javni-nil porsi mapti ignore-namapti) |
---|
96 | (mapti porsi (nunvalsi-nil empty-list))) |
---|
97 | javni-nil)) |
---|
98 | |
---|
99 | |
---|
100 | ;; selci: parse the end of input. |
---|
101 | ;; |
---|
102 | ;; Should this rule return the sentinel character, or should there |
---|
103 | ;; be a separate option for the value to return at the end of the file? |
---|
104 | ;; |
---|
105 | (define (nunjavni-fanmo #!key cmene (nastura #t) porjahe (sentinel #\nul)) |
---|
106 | (let ((nunvalsi-fanmo (make-nunvalsi cmene nastura porjahe))) |
---|
107 | (define (javni-fanmo porsi mapti namapti) |
---|
108 | (if (lerfu-porsi-fanmo? porsi) |
---|
109 | (mapti porsi (nunvalsi-fanmo sentinel)) |
---|
110 | (namapti porsi))) |
---|
111 | javni-fanmo)) |
---|
112 | |
---|
113 | |
---|
114 | ;; selci: parse the specified string |
---|
115 | ;; |
---|
116 | (define (nunjavni-valsi valsi #!key cmene (nastura #t) porjahe) |
---|
117 | (define list-prefix? |
---|
118 | (lambda (vla poi) |
---|
119 | (cond ((null? vla) poi) |
---|
120 | ((null? poi) #f) |
---|
121 | ((char=? (car vla) (car poi)) (list-prefix? (cdr vla) (cdr poi))) |
---|
122 | (else #f)))) |
---|
123 | |
---|
124 | (let ((vlapoi (string->list valsi)) |
---|
125 | (nunvalsi-valsi (make-nunvalsi cmene nastura porjahe))) |
---|
126 | (define (javni-valsi porsi mapti namapti) |
---|
127 | (let ((poi (list-prefix? vlapoi porsi))) |
---|
128 | (if poi |
---|
129 | (mapti poi (nunvalsi-valsi valsi)) |
---|
130 | (namapti porsi)))) |
---|
131 | javni-valsi)) |
---|
132 | |
---|
133 | |
---|
134 | (define (nunjavni-char-set-* char-set #!key cmene nastura porjahe) |
---|
135 | (let ((nunvalsi-char-set-* (make-nunvalsi cmene nastura porjahe)) |
---|
136 | (contains? (lambda (poi) (char-set-contains? char-set poi)))) |
---|
137 | (define (javni-char-set-* porsi |
---|
138 | mapti |
---|
139 | ignore-namapti |
---|
140 | ; if we're matching one or |
---|
141 | ; more, this will be advanced |
---|
142 | ; by one. |
---|
143 | #!key (cfari (list '())) |
---|
144 | (fanmo cfari)) |
---|
145 | (define (mapti-char-set-* porsi valsi) |
---|
146 | (mapti porsi (nunvalsi-char-set-* valsi))) |
---|
147 | |
---|
148 | (call-with-values |
---|
149 | (lambda () (span contains? porsi)) |
---|
150 | (lambda (vla poi) |
---|
151 | (set-cdr! fanmo vla) |
---|
152 | (mapti-char-set-* poi (list->string (cdr cfari)))))) |
---|
153 | javni-char-set-*)) |
---|
154 | |
---|
155 | |
---|
156 | (define (nunjavni-char-set-+ char-set #!key cmene nastura porjahe) |
---|
157 | (let ((javni-char-set-* (nunjavni-char-set-* char-set |
---|
158 | cmene: cmene |
---|
159 | nastura: nastura |
---|
160 | porjahe: porjahe))) |
---|
161 | (define (javni-char-set-+ porsi mapti namapti) |
---|
162 | (if (char-set-contains? char-set (car porsi)) |
---|
163 | (let ((cfari `(() ,(car porsi)))) |
---|
164 | (javni-char-set-* (cdr porsi) |
---|
165 | mapti |
---|
166 | namapti |
---|
167 | cfari: cfari |
---|
168 | fanmo: (cdr cfari))) |
---|
169 | (namapti porsi))) |
---|
170 | javni-char-set-+)) |
---|
171 | |
---|
172 | (define (nunjavni-char-set-kuspe char-set #!key cmene |
---|
173 | nastura |
---|
174 | porjahe |
---|
175 | (my 0) |
---|
176 | (ny most-positive-fixnum)) |
---|
177 | (let ((nunvalsi-char-set-kuspe (make-nunvalsi cmene nastura porjahe)) |
---|
178 | (contains? (lambda (porsi) (char-set-contains? char-set (car porsi))))) |
---|
179 | (define (javni-char-set-kuspe porsi mapti namapti) |
---|
180 | (define (mapti-char-set-kuspe porsi valsi) |
---|
181 | (mapti porsi (nunvalsi-char-set-kuspe (list->string valsi)))) |
---|
182 | |
---|
183 | (span-kuspe contains? |
---|
184 | porsi |
---|
185 | mapti-char-set-kuspe |
---|
186 | namapti |
---|
187 | my: my |
---|
188 | ny: ny)) |
---|
189 | |
---|
190 | javni-char-set-kuspe)) |
---|
191 | |
---|
192 | (define (nunjavni-char-set char-set #!key cmene nastura porjahe) |
---|
193 | (let ((nunvalsi-char-set (make-nunvalsi cmene nastura porjahe))) |
---|
194 | (define (javni-char-set porsi mapti namapti) |
---|
195 | (let ((lerfu (car porsi))) |
---|
196 | (if (char-set-contains? char-set lerfu) |
---|
197 | (mapti (cdr porsi) (nunvalsi-char-set lerfu)) |
---|
198 | (namapti porsi)))) |
---|
199 | javni-char-set)) |
---|
200 | |
---|
201 | ;; zero-or-more: parse zero or more javni out of the |lerfu-porsi|. |
---|
202 | ;; |
---|
203 | (define (nunjavni-* javni #!key cmene nastura porjahe porsumti (default '())) |
---|
204 | (let ((vejmina (venunjmina-rodavalsi-* cmene |
---|
205 | nastura |
---|
206 | porjahe |
---|
207 | porsumti)) |
---|
208 | (novejmina (novejmina-nunvalsi cmene nastura porjahe default #f))) |
---|
209 | (define (suhopa-javni-* porsi |
---|
210 | mapti |
---|
211 | namapti |
---|
212 | ; a "dummy head" is a linked-list |
---|
213 | ; optimization we'll return the cdr |
---|
214 | ; of this list, but by using this |
---|
215 | ; extra cons we avoid checking for |
---|
216 | ; the beginning of the list below. |
---|
217 | ; |
---|
218 | #!key (cfari (list '())) |
---|
219 | (fanmo cfari)) |
---|
220 | (define (mapti-* porsi nunvalsi) |
---|
221 | ; append this result to the result list |
---|
222 | (set-cdr! fanmo (list nunvalsi)) |
---|
223 | (suhopa-javni-* porsi |
---|
224 | mapti |
---|
225 | namapti |
---|
226 | cfari: cfari |
---|
227 | fanmo: (cdr fanmo))) |
---|
228 | |
---|
229 | (define (namapti-* porsi) |
---|
230 | ; ignore the failure in |ignore-nunjavni|, as |
---|
231 | ; this javni cannot fail. |porsi| is not advanced |
---|
232 | ; on failure, so we can use it, capturing any |
---|
233 | ; cases that did succeed. |
---|
234 | ; |
---|
235 | (mapti porsi (vejmina (cdr cfari)))) |
---|
236 | |
---|
237 | (javni porsi mapti-* namapti-*)) |
---|
238 | |
---|
239 | (define (pamoi-javni-* porsi |
---|
240 | mapti |
---|
241 | namapti |
---|
242 | ; a "dummy head" is a linked-list |
---|
243 | ; optimization we'll return the cdr |
---|
244 | ; of this list, but by using this |
---|
245 | ; extra cons we avoid checking for |
---|
246 | ; the beginning of the list below. |
---|
247 | ; |
---|
248 | #!key (cfari (list '())) |
---|
249 | (fanmo cfari)) |
---|
250 | (define (mapti-* porsi nunvalsi) |
---|
251 | ; append this result to the result list |
---|
252 | (set-cdr! fanmo (list nunvalsi)) |
---|
253 | (suhopa-javni-* porsi |
---|
254 | mapti |
---|
255 | namapti |
---|
256 | cfari: cfari |
---|
257 | fanmo: (cdr fanmo))) |
---|
258 | |
---|
259 | (define (namapti-* porsi) |
---|
260 | ; ignore the failure in |ignore-nunjavni|, as |
---|
261 | ; this javni cannot fail. |porsi| is not advanced |
---|
262 | ; on failure, so we can use it, capturing any |
---|
263 | ; cases that did succeed. |
---|
264 | ; |
---|
265 | (mapti porsi novejmina)) |
---|
266 | |
---|
267 | (javni porsi mapti-* namapti-*)) |
---|
268 | |
---|
269 | (values pamoi-javni-* suhopa-javni-*))) |
---|
270 | |
---|
271 | |
---|
272 | ;; one-or-more: parse one or more javni out of the |lerfu-porsi|. |
---|
273 | ;; |
---|
274 | (define (nunjavni-+ javni #!key cmene nastura porjahe porsumti) |
---|
275 | (let ((javni-* (call-with-values |
---|
276 | (lambda () |
---|
277 | (nunjavni-* javni |
---|
278 | cmene: cmene |
---|
279 | nastura: nastura |
---|
280 | porjahe: porjahe |
---|
281 | porsumti: porsumti)) |
---|
282 | (lambda (pamoi suhopa) |
---|
283 | suhopa)))) |
---|
284 | (define (javni-+ porsi mapti namapti) |
---|
285 | (define (mapti-+ porsi nunvalsi) |
---|
286 | (let ((fanmo (list nunvalsi))) |
---|
287 | (javni-* porsi |
---|
288 | mapti |
---|
289 | namapti |
---|
290 | cfari: (cons '() fanmo) |
---|
291 | fanmo: fanmo))) |
---|
292 | (javni porsi mapti-+ namapti)) |
---|
293 | javni-+)) |
---|
294 | |
---|
295 | |
---|
296 | ;; range: parse N,M javni out of the |lerfu-porsi|. |
---|
297 | ; |
---|
298 | ;; javni{n,m} => match at least m and no more than n times. |
---|
299 | ;; javni{m} => javni{n,n} => match exactly m times. |
---|
300 | ;; javni{m,} => javni{n,inf} => match m or more times. |
---|
301 | ;; javni{,n} => javni{0,n} => match zero to n times. |
---|
302 | ;; javni{,} => javni{0,inf} => match zero-or-more times. |
---|
303 | ;; javni{} => javni{0,inf} => match zero-or-more times. |
---|
304 | ;; |
---|
305 | (define (nunjavni-kuspe javni #!key cmene |
---|
306 | nastura |
---|
307 | porjahe |
---|
308 | porsumti |
---|
309 | (default '()) |
---|
310 | (my 0) |
---|
311 | (ny most-positive-fixnum)) |
---|
312 | (let ((vejmina (venunjmina-rodavalsi-* cmene |
---|
313 | nastura |
---|
314 | porjahe |
---|
315 | porsumti)) |
---|
316 | (novejmina (novejmina-nunvalsi cmene nastura porjahe default #f))) |
---|
317 | (define (suhopa-javni-kuspe porsi |
---|
318 | mapti |
---|
319 | namapti |
---|
320 | ; a "dummy head" is a linked-list |
---|
321 | ; optimization we'll return the cdr |
---|
322 | ; of this list, but by using this |
---|
323 | ; extra cons we avoid checking for |
---|
324 | ; the beginning of the list below. |
---|
325 | ; |
---|
326 | #!key (cfari (list '())) |
---|
327 | (fanmo cfari) |
---|
328 | (klani 1)) |
---|
329 | (define (mapti-kuspe porsi nunvalsi) |
---|
330 | ; append this result to the result list |
---|
331 | (set-cdr! fanmo (list nunvalsi)) |
---|
332 | |
---|
333 | ; if we have matched up to our limit, succeed. |
---|
334 | ; otherwise keep matching. |
---|
335 | ; |
---|
336 | (if (fx= ny klani) |
---|
337 | (mapti porsi (vejmina (cdr cfari))) |
---|
338 | (suhopa-javni-kuspe porsi |
---|
339 | mapti |
---|
340 | namapti |
---|
341 | cfari: cfari |
---|
342 | fanmo: (cdr fanmo) |
---|
343 | klani: (fx+ 1 klani)))) |
---|
344 | |
---|
345 | (define (namapti-kuspe porsi) |
---|
346 | (if (fx> klani my) |
---|
347 | (mapti porsi (vejmina (cdr cfari))) |
---|
348 | (namapti porsi))) |
---|
349 | |
---|
350 | (javni porsi mapti-kuspe namapti-kuspe)) |
---|
351 | |
---|
352 | (define (pamoi-javni-kuspe porsi |
---|
353 | mapti |
---|
354 | namapti |
---|
355 | ; a "dummy head" is a linked-list |
---|
356 | ; optimization we'll return the cdr |
---|
357 | ; of this list, but by using this |
---|
358 | ; extra cons we avoid checking for |
---|
359 | ; the beginning of the list below. |
---|
360 | ; |
---|
361 | #!key (cfari (list '())) |
---|
362 | (fanmo cfari) |
---|
363 | (klani 1)) |
---|
364 | (define (mapti-kuspe porsi nunvalsi) |
---|
365 | ; append this result to the result list |
---|
366 | (set-cdr! fanmo (list nunvalsi)) |
---|
367 | |
---|
368 | ; if we have matched up to our limit, succeed. |
---|
369 | ; otherwise keep matching. |
---|
370 | ; |
---|
371 | (if (fx= ny klani) |
---|
372 | (mapti porsi (vejmina (cdr cfari))) |
---|
373 | (suhopa-javni-kuspe porsi |
---|
374 | mapti |
---|
375 | namapti |
---|
376 | cfari: cfari |
---|
377 | fanmo: (cdr fanmo) |
---|
378 | klani: (fx+ 1 klani)))) |
---|
379 | |
---|
380 | (define (namapti-kuspe porsi) |
---|
381 | (if (fx> klani my) |
---|
382 | (mapti porsi novejmina) |
---|
383 | (namapti porsi))) |
---|
384 | |
---|
385 | (javni porsi mapti-kuspe namapti-kuspe)) |
---|
386 | |
---|
387 | pamoi-javni-kuspe)) |
---|
388 | |
---|
389 | |
---|
390 | |
---|
391 | ;; optional: parse an optional javni out of the |lerfu-porsi|. |
---|
392 | ;; |
---|
393 | (define (nunjavni-? javni #!key cmene |
---|
394 | nastura |
---|
395 | porjahe |
---|
396 | porsumti |
---|
397 | (default "") |
---|
398 | ni) |
---|
399 | (let ((vejmina (venunjmina-nunvalsi cmene nastura porjahe porsumti)) |
---|
400 | (novejmina (novejmina-nunvalsi cmene nastura porjahe default ni))) |
---|
401 | (define (javni-? porsi mapti ignore-namapti) |
---|
402 | |
---|
403 | (define (mapti-? porsi nunvalsi) |
---|
404 | (mapti porsi (vejmina nunvalsi))) |
---|
405 | |
---|
406 | (define (namapti-? porsi) |
---|
407 | ; ignore the failure in |ignore-nunvalsi|, as |
---|
408 | ; this javni cannot fail. |porsi| is not advanced |
---|
409 | ; on failure, so we can use it. |
---|
410 | ; |
---|
411 | (mapti porsi novejmina)) |
---|
412 | |
---|
413 | (javni porsi mapti-? namapti-?)) |
---|
414 | javni-?)) |
---|
415 | |
---|
416 | |
---|
417 | ;; and-predicate: succeed or fail without consuming input. |
---|
418 | ;; |
---|
419 | (define (nunjavni-& javni #!key porjahe) |
---|
420 | (let ((nunvalsi-& (make-nunvalsi-predicate porjahe))) |
---|
421 | (define (javni-& porsi mapti namapti) |
---|
422 | (define (mapti-& ignore-porsi ignore-nunvalsi) |
---|
423 | (mapti porsi nunvalsi-&)) |
---|
424 | |
---|
425 | (define (namapti-& ignore-porsi) |
---|
426 | (namapti porsi)) |
---|
427 | |
---|
428 | (javni porsi mapti-& namapti-&)) |
---|
429 | javni-&)) |
---|
430 | |
---|
431 | |
---|
432 | ;; not-predicate: require that |javni| is not able to be parsed from |
---|
433 | ;; the |lerfu-porsi|. |
---|
434 | ;; |
---|
435 | (define (nunjavni-! javni #!key porjahe) |
---|
436 | (let ((nunvalsi-! (make-nunvalsi-predicate porjahe))) |
---|
437 | (define (javni-! porsi mapti namapti) |
---|
438 | (define (mapti-! ignore-porsi ignore-nunvalsi) |
---|
439 | (namapti porsi)) |
---|
440 | |
---|
441 | (define (namapti-! ignore-porsi) |
---|
442 | (mapti porsi nunvalsi-!)) |
---|
443 | |
---|
444 | (javni porsi mapti-! namapti-!)) |
---|
445 | javni-!)) |
---|
446 | |
---|
447 | |
---|
448 | ;; sequence: parse |ro da javni| out of the |lerfu-porsi|. |
---|
449 | ;; if any of the do not match, none of them match. |
---|
450 | ;; |
---|
451 | (define (nunjavni-je rodajavni #!key cmene nastura porjahe porsumti) |
---|
452 | (let ((vejmina (venunjmina-rodavalsi-je cmene nastura porjahe porsumti))) |
---|
453 | (define (javni-je porsi |
---|
454 | mapti |
---|
455 | namapti |
---|
456 | ; capture the initial position, and |
---|
457 | ; then continue to pass it as we |
---|
458 | ; call ourselves recursively. |
---|
459 | #!key (cfari-porsi porsi) |
---|
460 | ; the current rule we're trying. |
---|
461 | (rodajavni rodajavni) |
---|
462 | ; a "dummy head" is a linked-list |
---|
463 | ; optimization we'll return the cdr |
---|
464 | ; of this list, but by using this |
---|
465 | ; extra cons we avoid checking for |
---|
466 | ; the beginning of the list below. |
---|
467 | ; |
---|
468 | (cfari (list '())) |
---|
469 | (fanmo cfari)) |
---|
470 | ; the (nun)valsi passed to us might |
---|
471 | ; include previously matched javni. If |
---|
472 | ; we fail to match a javni, ignore the |
---|
473 | ; porsi passed to us and use the one from |
---|
474 | ; the start of this parse rule. |
---|
475 | ; |
---|
476 | (define (namapti-je ignore-porsi) |
---|
477 | (namapti cfari-porsi)) |
---|
478 | |
---|
479 | (let ((javni (car rodajavni)) |
---|
480 | (rest (cdr rodajavni))) |
---|
481 | (if (null? rest) |
---|
482 | |
---|
483 | ; called at the end of the list |
---|
484 | (let ((mapti-je (lambda (porsi nunvalsi) |
---|
485 | (set-cdr! fanmo (list nunvalsi)) |
---|
486 | (mapti porsi (vejmina (cdr cfari)))))) |
---|
487 | (javni porsi mapti-je namapti-je)) |
---|
488 | |
---|
489 | ; called when there are still elements in the list |
---|
490 | (let ((mapti-je (lambda (porsi nunvalsi) |
---|
491 | (set-cdr! fanmo (list nunvalsi)) |
---|
492 | (javni-je porsi |
---|
493 | mapti |
---|
494 | namapti |
---|
495 | cfari-porsi: cfari-porsi |
---|
496 | rodajavni: rest |
---|
497 | cfari: cfari |
---|
498 | fanmo: (cdr fanmo))))) |
---|
499 | (javni porsi mapti-je namapti-je))))) |
---|
500 | javni-je)) |
---|
501 | |
---|
502 | |
---|
503 | ;; ordered-choice: parse the first matching javni out of the |
---|
504 | ;; |lerfu-porsi|. |
---|
505 | ;; |
---|
506 | (define (nunjavni-jonai rodajavni #!key cmene nastura porjahe porsumti) |
---|
507 | (let ((vejmina (venunjmina-nunvalsi cmene nastura porjahe porsumti))) |
---|
508 | (define (javni-jonai porsi |
---|
509 | mapti |
---|
510 | namapti |
---|
511 | #!optional (rodajavni rodajavni)) |
---|
512 | (define (mapti-jonai porsi nunvalsi) |
---|
513 | ;(pretty-print `(jonai ,nunvalsi ,(vejmina nunvalsi))) |
---|
514 | (mapti porsi (vejmina nunvalsi))) |
---|
515 | |
---|
516 | (let ((javni (car rodajavni)) |
---|
517 | (rest (cdr rodajavni))) |
---|
518 | (if (null? rest) |
---|
519 | ; called at the end of the list |
---|
520 | (javni porsi mapti-jonai namapti) |
---|
521 | |
---|
522 | ; called when there are still elements in the list |
---|
523 | (let ((namapti-jonai (lambda (porsi) |
---|
524 | (javni-jonai porsi |
---|
525 | mapti |
---|
526 | namapti |
---|
527 | rest)))) |
---|
528 | (javni porsi mapti-jonai namapti-jonai))))) |
---|
529 | javni-jonai)) |
---|
530 | |
---|
531 | |
---|
532 | ;; convert a single result to a list. Called with non-terminal |
---|
533 | ;; rules |
---|
534 | ;; |
---|
535 | (define (nunjavni-porjahe javni) |
---|
536 | (define (javni-porjahe porsi mapti namapti) |
---|
537 | (define (mapti-porjahe porsi nunvalsi) |
---|
538 | (mapti porsi `(,nunvalsi))) |
---|
539 | |
---|
540 | (javni porsi mapti-porjahe namapti)) |
---|
541 | |
---|
542 | javni-porjahe) |
---|
543 | |
---|
544 | |
---|
545 | ;; morji: memoization is done to ensure we run in linear time. |
---|
546 | ;; Any javni can be memoized, though the compiler only |
---|
547 | ;; memoizes non-terminals above a certain level of |
---|
548 | ;; complexity. |
---|
549 | ;; |
---|
550 | (define-values (genturfahi-semorji genturfahi-tolmohi nunjavni-morji) |
---|
551 | (let ((rodasemorji '()) |
---|
552 | (rodatolmohi '())) |
---|
553 | (values |
---|
554 | (lambda (nilcla) |
---|
555 | (map (lambda (semorji) (semorji nilcla)) rodasemorji)) |
---|
556 | |
---|
557 | (lambda () |
---|
558 | (map (lambda (tolmohi) (tolmohi)) rodatolmohi)) |
---|
559 | |
---|
560 | (lambda (javni) |
---|
561 | (let ((morji '())) |
---|
562 | (define (semorji nilcla) |
---|
563 | (let ((klani (quotient nilcla 2))) |
---|
564 | (set! morji |
---|
565 | (make-hash-table eq? size: (if (= 0 klani) 1 klani))))) |
---|
566 | |
---|
567 | (define (tolmohi) |
---|
568 | (set! morji '())) |
---|
569 | |
---|
570 | (define (javni-morji morji-porsi mapti namapti) |
---|
571 | ;; mapti |
---|
572 | (define (set-mapti-morji! porsi nunvalsi) |
---|
573 | (define (mapti-morji mapti ignore-namapti) |
---|
574 | (mapti porsi nunvalsi)) |
---|
575 | |
---|
576 | (hash-table-set! morji morji-porsi mapti-morji)) |
---|
577 | |
---|
578 | ;; namapti |
---|
579 | (define (set-namapti-morji! porsi) |
---|
580 | (define (namapti-morji ignore-mapti namapti) |
---|
581 | (namapti porsi)) |
---|
582 | |
---|
583 | (hash-table-set! morji morji-porsi namapti-morji)) |
---|
584 | |
---|
585 | ;; recurse |
---|
586 | (define (set-recurse-morji!) |
---|
587 | (define (recurse-morji ignore-mapti namapti) |
---|
588 | (namapti morji-porsi)) |
---|
589 | |
---|
590 | (hash-table-set! morji morji-porsi recurse-morji)) |
---|
591 | |
---|
592 | (define (javni-nomorji) |
---|
593 | (define (mapti-morji porsi nunvalsi) |
---|
594 | (set-mapti-morji! porsi nunvalsi) |
---|
595 | (mapti porsi nunvalsi)) |
---|
596 | |
---|
597 | (define (namapti-morji porsi) |
---|
598 | (set-namapti-morji! porsi) |
---|
599 | (namapti porsi)) |
---|
600 | |
---|
601 | ; register this parse position to detect left |
---|
602 | ; recursion. |
---|
603 | (set-recurse-morji!) |
---|
604 | |
---|
605 | (javni morji-porsi mapti-morji namapti-morji)) |
---|
606 | |
---|
607 | (let ((nunjalge |
---|
608 | (hash-table-ref/default morji morji-porsi #f))) |
---|
609 | (if nunjalge (nunjalge mapti namapti) (javni-nomorji)))) |
---|
610 | |
---|
611 | ; register this cache so we can initialize and clear. |
---|
612 | ; This routine customizes itself based on the input size, |
---|
613 | ; and we can free up a substantial amount of memory if |
---|
614 | ; we clear the caches after we're done parsing. |
---|
615 | ; |
---|
616 | (set! rodasemorji (cons semorji rodasemorji)) |
---|
617 | (set! rodatolmohi (cons tolmohi rodatolmohi)) |
---|
618 | |
---|
619 | javni-morji))))) |
---|
620 | |
---|
621 | (define (nunjavni-samselpla samselpla javni #!key cmene porjahe) |
---|
622 | (let ((nunvalsi-samselpla (make-nunvalsi cmene #f porjahe))) |
---|
623 | (define (javni-samselpla porsi mapti namapti) |
---|
624 | (define (mapti-samselpla porsi nunvalsi) |
---|
625 | (define (samselpla-sumti rodavalsi) |
---|
626 | (call-with-values |
---|
627 | (lambda () |
---|
628 | (partition javni-valsi? rodavalsi)) |
---|
629 | |
---|
630 | (lambda (cmesumti sumti) |
---|
631 | (let ((key (append-map |
---|
632 | (lambda (javni) |
---|
633 | (let ((cme (javni-valsi-cme javni)) |
---|
634 | (val (javni-valsi-val* javni))) |
---|
635 | `(,(string->keyword cme) ,val))) |
---|
636 | cmesumti)) |
---|
637 | (rest (javni-rodavalsi-samselpla sumti))) |
---|
638 | (append rest key))))) |
---|
639 | |
---|
640 | (define (samselpla-nunvalsi) |
---|
641 | (let* ((rodaval (samselpla-sumti nunvalsi)) |
---|
642 | (valsi (apply samselpla rodaval))) |
---|
643 | (nunvalsi-samselpla valsi))) |
---|
644 | |
---|
645 | (mapti porsi (samselpla-nunvalsi))) |
---|
646 | |
---|
647 | (javni porsi mapti-samselpla namapti)) |
---|
648 | javni-samselpla)) |
---|
649 | |
---|
650 | (define (nunjavni-samselpla-cabna samselpla javni #!key cmene porjahe) |
---|
651 | (let ((nunvalsi-samselpla-cabna (make-nunvalsi cmene #f porjahe)) |
---|
652 | (javni-samselpla (nunjavni-samselpla samselpla javni |
---|
653 | porjahe: porjahe))) |
---|
654 | (define (javni-samselpla-cabna porsi mapti namapti) |
---|
655 | (define (mapti-samselpla-cabna mapti-porsi nunvalsi) |
---|
656 | (if (eq? (secuxna-nonmatch-token) nunvalsi) |
---|
657 | (namapti porsi) |
---|
658 | (mapti mapti-porsi |
---|
659 | (nunvalsi-samselpla-cabna nunvalsi)))) |
---|
660 | |
---|
661 | (javni-samselpla porsi mapti-samselpla-cabna namapti)) |
---|
662 | javni-samselpla-cabna)) |
---|
663 | |
---|
664 | (define (nunjavni-cmene javni #!key cmene nastura porjahe) |
---|
665 | (let ((nunvalsi-cmene (make-nunvalsi cmene nastura porjahe))) |
---|
666 | (define (javni-cmene porsi mapti namapti) |
---|
667 | (define (mapti-cmene porsi nunvalsi) |
---|
668 | (mapti porsi |
---|
669 | (nunvalsi-cmene nunvalsi))) |
---|
670 | (javni porsi mapti-cmene namapti)) |
---|
671 | javni-cmene)) |
---|
672 | |
---|
673 | ;; backtick operator |
---|
674 | ;; |
---|
675 | (define (nunjavni-nastura javni #!key porjahe) |
---|
676 | (let ((nunvalsi-nastura (make-nunvalsi-predicate porjahe))) |
---|
677 | (define (javni-nastura porsi mapti namapti) |
---|
678 | (define (mapti-nastura porsi ignore-nunvalsi) |
---|
679 | (mapti porsi nunvalsi-nastura)) |
---|
680 | (javni porsi mapti-nastura namapti)) |
---|
681 | javni-nastura)) |
---|
682 | |
---|
683 | ;; decorate each rule according to the options specified. |
---|
684 | ;; |
---|
685 | (define (nunjavni-secuxna nuncmene javni #!rest cmene-sumti) |
---|
686 | (define (cfisisku cmene javni) |
---|
687 | (if (secuxna-debug) |
---|
688 | (apply nunjavni-cfisisku cmene javni cmene-sumti) |
---|
689 | javni)) |
---|
690 | |
---|
691 | (define (junla cmene javni) |
---|
692 | (if (secuxna-profile) |
---|
693 | (apply nunjavni-junla cmene javni cmene-sumti) |
---|
694 | javni)) |
---|
695 | |
---|
696 | (if (or (secuxna-debug) (secuxna-profile)) |
---|
697 | (let ((cmene (nuncmene))) |
---|
698 | (cfisisku cmene (junla cmene javni))) |
---|
699 | javni)) |
---|