bootstrap
view genesis/church/prolog/prolog-parser.church @ 616:723871f2f056
comment out more debug statements
fix up interpreter-test
fix up interpreter-test
| author | John Leuner <jewel@subvert-the-dominant-paradigm.net> |
|---|---|
| date | Sun Nov 22 12:55:44 2009 +0200 (2009-11-22) |
| parents | cb1011f9c9e0 |
| children |
line source
1 extern o-fail
2 comment o:prolog-parser arg
3 (begin
4 answer1 = nil
5 (begin
6 answer1 = (ometa-apply o 'token (list "/*" ))
7 if (o-fail? answer1)
8 o-fail
9 else
10 (begin
11 answer1 = (ometa-apply o 'omany (fn o nullarg -- (begin
12 answer2 = nil
13 (begin
14 answer2 = (ometa-apply o 'onot (fn o nullarg -- (ometa-apply o 'cnewline (list ))))
15 if (o-fail? answer2)
16 o-fail
17 else
18 (begin
19 answer2 = (ometa-apply o 'anything (list ))
20 if (o-fail? answer2)
21 o-fail
22 else
23 answer2
24 )
25 )
26 )))
27 if (o-fail? answer1)
28 o-fail
29 else
30 (begin
31 answer1 = (ometa-apply o 'cnewline (list ))
32 if (o-fail? answer1)
33 o-fail
34 else
35 (begin
36 answer1 = '_comment
37 if (o-fail? answer1)
38 o-fail
39 else
40 answer1
41 )
42 )
43 )
44 )
45 )
47 ws o:prolog-parser arg
48 (begin
49 save-input o
50 answer3 = nil
51 (begin
52 restore-input o
53 answer3 = (match-char o $ )
54 )
55 if (o-fail? answer3)
56 (begin
57 restore-input o
58 answer3 = (match-char o $ )
59 )
60 if (o-fail? answer3)
61 'done
62 discard-input o
63 answer3
64 )
66 wsnl o:prolog-parser arg
67 (begin
68 save-input o
69 answer4 = nil
70 (begin
71 restore-input o
72 answer4 = (ometa-apply o 'ws (list ))
73 )
74 if (o-fail? answer4)
75 (begin
76 restore-input o
77 answer4 = (ometa-apply o 'cnewline (list ))
78 )
79 if (o-fail? answer4)
80 'done
81 discard-input o
82 answer4
83 )
85 prolog-top-levels o:prolog-parser arg
86 (ometa-apply o 'omany (fn o nullarg -- (begin
87 save-input o
88 answer5 = nil
89 (begin
90 restore-input o
91 answer5 = (ometa-apply o 'comment (list ))
92 )
93 if (o-fail? answer5)
94 (begin
95 restore-input o
96 answer5 = (ometa-apply o 'prolog-rule (list ))
97 )
98 if (o-fail? answer5)
99 'done
100 discard-input o
101 answer5
102 )))
104 prolog-rule o:prolog-parser arg
105 body = nil
106 rhead = nil
107 (begin
108 answer6 = nil
109 (begin
110 answer6 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
111 if (o-fail? answer6)
112 o-fail
113 else
114 (begin
115 answer6 = (rhead = (ometa-apply o 'prolog-clause (list )))
116 if (o-fail? answer6)
117 o-fail
118 else
119 (begin
120 answer6 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'ws (list ))))
121 if (o-fail? answer6)
122 o-fail
123 else
124 (begin
125 answer6 = (ometa-apply o 'omany (fn o nullarg -- (begin
126 answer7 = nil
127 (begin
128 answer7 = (ometa-apply o 'token (list ":-" ))
129 if (o-fail? answer7)
130 o-fail
131 else
132 (begin
133 answer7 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'ws (list ))))
134 if (o-fail? answer7)
135 o-fail
136 else
137 (begin
138 answer7 = (body = (ometa-apply o 'prolog-or (list )))
139 if (o-fail? answer7)
140 o-fail
141 else
142 (begin
143 answer7 = body
144 if (o-fail? answer7)
145 o-fail
146 else
147 answer7
148 )
149 )
150 )
151 )
152 )))
153 if (o-fail? answer6)
154 o-fail
155 else
156 (begin
157 answer6 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'ws (list ))))
158 if (o-fail? answer6)
159 o-fail
160 else
161 (begin
162 answer6 = (match-char o $.)
163 if (o-fail? answer6)
164 o-fail
165 else
166 (begin
167 answer6 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
168 if (o-fail? answer6)
169 o-fail
170 else
171 (begin
172 answer6 = `[rule ,rhead ,body]
173 if (o-fail? answer6)
174 o-fail
175 else
176 answer6
177 )
178 )
179 )
180 )
181 )
182 )
183 )
184 )
185 )
187 prolog-or o:prolog-parser arg
188 e = nil
189 (begin
190 answer8 = nil
191 (begin
192 answer8 = (e = (ometa-apply o 'listof (list "prolog-impl" ";" )))
193 if (o-fail? answer8)
194 o-fail
195 else
196 (begin
197 answer8 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
198 if (o-fail? answer8)
199 o-fail
200 else
201 (begin
202 answer8 = `[or ,e]
203 if (o-fail? answer8)
204 o-fail
205 else
206 answer8
207 )
208 )
209 )
210 )
212 prolog-impl o:prolog-parser arg
213 b = nil
214 a = nil
215 (begin
216 save-input o
217 answer9 = nil
218 (begin
219 restore-input o
220 answer9 = (begin
221 answer10 = nil
222 (begin
223 answer10 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
224 if (o-fail? answer10)
225 o-fail
226 else
227 (begin
228 answer10 = (a = (ometa-apply o 'prolog-clause (list )))
229 if (o-fail? answer10)
230 o-fail
231 else
232 (begin
233 answer10 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
234 if (o-fail? answer10)
235 o-fail
236 else
237 (begin
238 answer10 = (ometa-apply o 'token (list "->" ))
239 if (o-fail? answer10)
240 o-fail
241 else
242 (begin
243 answer10 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
244 if (o-fail? answer10)
245 o-fail
246 else
247 (begin
248 answer10 = (b = (ometa-apply o 'prolog-or (list )))
249 if (o-fail? answer10)
250 o-fail
251 else
252 (begin
253 answer10 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
254 if (o-fail? answer10)
255 o-fail
256 else
257 (begin
258 answer10 = `[implies ,a ,b]
259 if (o-fail? answer10)
260 o-fail
261 else
262 answer10
263 )
264 )
265 )
266 )
267 )
268 )
269 )
270 )
271 )
272 )
273 if (o-fail? answer9)
274 (begin
275 restore-input o
276 answer9 = (ometa-apply o 'prolog-and (list ))
277 )
278 if (o-fail? answer9)
279 'done
280 discard-input o
281 answer9
282 )
284 prolog-and o:prolog-parser arg
285 e = nil
286 (begin
287 answer11 = nil
288 (begin
289 answer11 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
290 if (o-fail? answer11)
291 o-fail
292 else
293 (begin
294 answer11 = (e = (ometa-apply o 'listof (list "prolog-expr" "," )))
295 if (o-fail? answer11)
296 o-fail
297 else
298 (begin
299 answer11 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
300 if (o-fail? answer11)
301 o-fail
302 else
303 (begin
304 answer11 = `[and ,e]
305 if (o-fail? answer11)
306 o-fail
307 else
308 answer11
309 )
310 )
311 )
312 )
313 )
315 prolog-clause o:prolog-parser arg
316 args = nil
317 name = nil
318 (begin
319 answer12 = nil
320 (begin
321 answer12 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
322 if (o-fail? answer12)
323 o-fail
324 else
325 (begin
326 answer12 = (name = (ometa-apply o 'prolog-name (list )))
327 if (o-fail? answer12)
328 o-fail
329 else
330 (begin
331 answer12 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
332 if (o-fail? answer12)
333 o-fail
334 else
335 (begin
336 answer12 = (args = (ometa-apply o 'prolog-arg-list (list )))
337 if (o-fail? answer12)
338 o-fail
339 else
340 (begin
341 answer12 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
342 if (o-fail? answer12)
343 o-fail
344 else
345 (begin
346 answer12 = `[,name | ,args]
347 if (o-fail? answer12)
348 o-fail
349 else
350 answer12
351 )
352 )
353 )
354 )
355 )
356 )
357 )
359 prolog-arg-list o:prolog-parser arg
360 args = nil
361 (begin
362 answer13 = nil
363 (begin
364 answer13 = (match-char o $()
365 if (o-fail? answer13)
366 o-fail
367 else
368 (begin
369 answer13 = (args = (ometa-apply o 'listof (list "prolog-expr" "," )))
370 if (o-fail? answer13)
371 o-fail
372 else
373 (begin
374 answer13 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
375 if (o-fail? answer13)
376 o-fail
377 else
378 (begin
379 answer13 = (match-char o $))
380 if (o-fail? answer13)
381 o-fail
382 else
383 (begin
384 answer13 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
385 if (o-fail? answer13)
386 o-fail
387 else
388 (begin
389 answer13 = args
390 if (o-fail? answer13)
391 o-fail
392 else
393 answer13
394 )
395 )
396 )
397 )
398 )
399 )
400 )
402 prolog-expr o:prolog-parser arg
403 v = nil
404 c = nil
405 e = nil
406 list-tail = nil
407 list-head = nil
408 (begin
409 answer14 = nil
410 (begin
411 answer14 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
412 if (o-fail? answer14)
413 o-fail
414 else
415 (begin
416 answer14 = (begin
417 save-input o
418 answer15 = nil
419 (begin
420 restore-input o
421 answer15 = (begin
422 answer16 = nil
423 (begin
424 answer16 = (match-char o $[)
425 if (o-fail? answer16)
426 o-fail
427 else
428 (begin
429 answer16 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
430 if (o-fail? answer16)
431 o-fail
432 else
433 (begin
434 answer16 = (match-char o $])
435 if (o-fail? answer16)
436 o-fail
437 else
438 (begin
439 answer16 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
440 if (o-fail? answer16)
441 o-fail
442 else
443 (begin
444 answer16 = `[]
445 if (o-fail? answer16)
446 o-fail
447 else
448 answer16
449 )
450 )
451 )
452 )
453 )
454 )
455 )
456 if (o-fail? answer15)
457 (begin
458 restore-input o
459 answer15 = (begin
460 answer17 = nil
461 (begin
462 answer17 = (match-char o $[)
463 if (o-fail? answer17)
464 o-fail
465 else
466 (begin
467 answer17 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
468 if (o-fail? answer17)
469 o-fail
470 else
471 (begin
472 answer17 = (list-head = (ometa-apply o 'listof (list "prolog-expr" "," )))
473 if (o-fail? answer17)
474 o-fail
475 else
476 (begin
477 answer17 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'ws (list ))))
478 if (o-fail? answer17)
479 o-fail
480 else
481 (begin
482 answer17 = (list-tail = (ometa-apply o 'omany (fn o nullarg -- (begin
483 save-input o
484 answer18 = nil
485 (begin
486 restore-input o
487 answer18 = (begin
488 answer19 = nil
489 (begin
490 answer19 = (match-char o $|)
491 if (o-fail? answer19)
492 o-fail
493 else
494 (begin
495 answer19 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
496 if (o-fail? answer19)
497 o-fail
498 else
499 (begin
500 answer19 = (ometa-apply o 'prolog-expr (list ))
501 if (o-fail? answer19)
502 o-fail
503 else
504 answer19
505 )
506 )
507 )
508 )
509 )
510 if (o-fail? answer18)
511 'done
512 discard-input o
513 answer18
514 ))))
515 if (o-fail? answer17)
516 o-fail
517 else
518 (begin
519 answer17 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
520 if (o-fail? answer17)
521 o-fail
522 else
523 (begin
524 answer17 = (match-char o $])
525 if (o-fail? answer17)
526 o-fail
527 else
528 (begin
529 answer17 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
530 if (o-fail? answer17)
531 o-fail
532 else
533 (begin
534 answer17 = (append! list-head (if list-tail (first list-tail) nil))
535 if (o-fail? answer17)
536 o-fail
537 else
538 answer17
539 )
540 )
541 )
542 )
543 )
544 )
545 )
546 )
547 )
548 )
549 )
550 if (o-fail? answer15)
551 (begin
552 restore-input o
553 answer15 = (begin
554 answer20 = nil
555 (begin
556 answer20 = (match-char o $()
557 if (o-fail? answer20)
558 o-fail
559 else
560 (begin
561 answer20 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
562 if (o-fail? answer20)
563 o-fail
564 else
565 (begin
566 answer20 = (e = (ometa-apply o 'prolog-or (list )))
567 if (o-fail? answer20)
568 o-fail
569 else
570 (begin
571 answer20 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
572 if (o-fail? answer20)
573 o-fail
574 else
575 (begin
576 answer20 = (match-char o $))
577 if (o-fail? answer20)
578 o-fail
579 else
580 (begin
581 answer20 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
582 if (o-fail? answer20)
583 o-fail
584 else
585 (begin
586 answer20 = e
587 if (o-fail? answer20)
588 o-fail
589 else
590 answer20
591 )
592 )
593 )
594 )
595 )
596 )
597 )
598 )
599 )
600 if (o-fail? answer15)
601 (begin
602 restore-input o
603 answer15 = (begin
604 answer21 = nil
605 (begin
606 answer21 = (c = (ometa-apply o 'prolog-clause (list )))
607 if (o-fail? answer21)
608 o-fail
609 else
610 (begin
611 answer21 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
612 if (o-fail? answer21)
613 o-fail
614 else
615 (begin
616 answer21 = c
617 if (o-fail? answer21)
618 o-fail
619 else
620 answer21
621 )
622 )
623 )
624 )
625 )
626 if (o-fail? answer15)
627 (begin
628 restore-input o
629 answer15 = (ometa-apply o 'prolog-number (list ))
630 )
631 if (o-fail? answer15)
632 (begin
633 restore-input o
634 answer15 = (begin
635 answer22 = nil
636 (begin
637 answer22 = (v = (ometa-apply o 'prolog-variable (list )))
638 if (o-fail? answer22)
639 o-fail
640 else
641 (begin
642 answer22 = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'wsnl (list ))))
643 if (o-fail? answer22)
644 o-fail
645 else
646 (begin
647 answer22 = v
648 if (o-fail? answer22)
649 o-fail
650 else
651 answer22
652 )
653 )
654 )
655 )
656 )
657 if (o-fail? answer15)
658 'done
659 discard-input o
660 answer15
661 )
662 if (o-fail? answer14)
663 o-fail
664 else
665 answer14
666 )
667 )
668 )
670 prolog-number o:prolog-parser arg
671 d = nil
672 sign = nil
673 (begin
674 answer23 = nil
675 (begin
676 answer23 = (sign = (ometa-apply o 'omany (fn o nullarg -- (ometa-apply o 'token (list "-" )))))
677 if (o-fail? answer23)
678 o-fail
679 else
680 (begin
681 answer23 = (d = (ometa-apply o 'omany1 (fn o nullarg --(ometa-apply o 'digit (list )))))
682 if (o-fail? answer23)
683 o-fail
684 else
685 (begin
686 answer23 = (convert-number sign d)
687 if (o-fail? answer23)
688 o-fail
689 else
690 answer23
691 )
692 )
693 )
694 )
696 prolog-variable o:prolog-parser arg
697 l = nil
698 (begin
699 answer24 = nil
700 (begin
701 answer24 = (l = (ometa-apply o 'omany1 (fn o nullarg --(begin
702 save-input o
703 answer25 = nil
704 (begin
705 restore-input o
706 answer25 = (ometa-apply o 'letter (list ))
707 )
708 if (o-fail? answer25)
709 (begin
710 restore-input o
711 answer25 = (ometa-apply o 'digit (list ))
712 )
713 if (o-fail? answer25)
714 (begin
715 restore-input o
716 answer25 = (match-char o $_)
717 )
718 if (o-fail? answer25)
719 'done
720 discard-input o
721 answer25
722 ))))
723 if (o-fail? answer24)
724 o-fail
725 else
726 (begin
727 answer24 = (intern (coerce l 'string))
728 if (o-fail? answer24)
729 o-fail
730 else
731 answer24
732 )
733 )
734 )
736 prolog-name o:prolog-parser arg
737 l = nil
738 (begin
739 answer26 = nil
740 (begin
741 answer26 = (l = (ometa-apply o 'omany1 (fn o nullarg --(begin
742 save-input o
743 answer27 = nil
744 (begin
745 restore-input o
746 answer27 = (ometa-apply o 'letter (list ))
747 )
748 if (o-fail? answer27)
749 (begin
750 restore-input o
751 answer27 = (ometa-apply o 'digit (list ))
752 )
753 if (o-fail? answer27)
754 (begin
755 restore-input o
756 answer27 = (match-char o $_)
757 )
758 if (o-fail? answer27)
759 'done
760 discard-input o
761 answer27
762 ))))
763 if (o-fail? answer26)
764 o-fail
765 else
766 (begin
767 answer26 = (intern (coerce l 'string))
768 if (o-fail? answer26)
769 o-fail
770 else
771 answer26
772 )
773 )
774 )