Artifact 077385b729f415b9cf7d3bc04c8d14b5fb609035:
- File lalr/lalr.ss — part of check-in [89d5aac0dc] at 2016-08-17 07:45:09 on branch trunk — added lalr (user: ovenpasta@pizzahack.eu size: 17179)
0000: 3b 3b 3b 20 6c 61 6c 72 2e 73 73 20 2d 20 41 6e ;;; lalr.ss - An 0010: 20 4c 41 4c 52 28 31 29 20 70 61 72 73 65 72 20 LALR(1) parser 0020: 67 65 6e 65 72 61 74 6f 72 0a 3b 3b 3b 0a 3b 3b generator.;;;.;; 0030: 3b 20 41 75 74 68 6f 72 3a 20 4d 61 72 6b 20 4a ; Author: Mark J 0040: 6f 68 6e 73 6f 6e 20 28 6d 6a 40 63 73 2e 62 72 ohnson (mj@cs.br 0050: 6f 77 6e 2e 65 64 75 29 0a 3b 3b 3b 20 44 61 74 own.edu).;;; Dat 0060: 65 3a 20 32 34 74 68 20 4d 61 79 2c 20 31 39 39 e: 24th May, 199 0070: 33 0a 3b 3b 3b 20 56 65 72 73 69 6f 6e 3a 20 30 3.;;; Version: 0 0080: 2e 39 20 0a 3b 3b 3b 0a 3b 3b 3b 0a 3b 3b 3b 20 .9 .;;;.;;;.;;; 0090: 54 68 65 20 70 61 72 73 65 72 20 67 65 6e 65 72 The parser gener 00a0: 61 74 6f 72 20 63 6f 6e 73 69 73 74 73 20 6f 66 ator consists of 00b0: 20 74 77 6f 20 66 75 6e 63 74 69 6f 6e 73 2e 20 two functions. 00c0: 20 54 68 65 20 66 69 72 73 74 20 63 6f 6e 73 74 The first const 00d0: 72 75 63 74 73 0a 3b 3b 3b 20 74 68 65 20 70 61 ructs.;;; the pa 00e0: 72 73 65 20 74 61 62 6c 65 73 2c 20 77 68 69 63 rse tables, whic 00f0: 68 20 74 68 65 20 73 65 63 6f 6e 64 20 66 75 6e h the second fun 0100: 63 74 69 6f 6e 20 75 73 65 73 20 74 6f 20 61 63 ction uses to ac 0110: 74 75 61 6c 6c 79 20 70 61 72 73 65 2e 0a 3b 3b tually parse..;; 0120: 3b 20 59 6f 75 20 63 61 6e 20 73 65 65 20 68 6f ; You can see ho 0130: 77 20 74 6f 20 75 73 65 20 74 68 65 73 65 20 69 w to use these i 0140: 6e 20 74 68 65 20 66 69 6c 65 20 6c 61 6c 72 2d n the file lalr- 0150: 74 65 73 74 2e 73 73 2e 0a 3b 3b 3b 0a 3b 3b 3b test.ss..;;;.;;; 0160: 20 28 6c 61 6c 72 2d 74 61 62 6c 65 20 67 72 61 (lalr-table gra 0170: 6d 6d 61 72 20 74 65 72 6d 69 6e 61 6c 73 20 70 mmar terminals p 0180: 72 69 6e 74 2d 74 61 62 6c 65 2d 66 6c 61 67 29 rint-table-flag) 0190: 20 72 65 74 75 72 6e 73 0a 3b 3b 3b 20 74 68 65 returns.;;; the 01a0: 20 6c 61 6c 72 20 70 61 72 73 69 6e 67 20 74 61 lalr parsing ta 01b0: 62 6c 65 20 66 6f 72 20 74 68 65 20 67 72 61 6d ble for the gram 01c0: 6d 61 72 2e 20 20 49 74 73 20 61 72 67 75 6d 65 mar. Its argume 01d0: 6e 74 73 20 61 72 65 3a 0a 3b 3b 3b 20 0a 3b 3b nts are:.;;; .;; 01e0: 3b 20 20 20 67 72 61 6d 6d 61 72 3a 20 41 20 6c ; grammar: A l 01f0: 69 73 74 20 6f 66 20 70 72 6f 64 75 63 74 69 6f ist of productio 0200: 6e 73 2c 20 65 61 63 68 20 6f 66 20 77 68 69 63 ns, each of whic 0210: 68 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 74 h is a list of t 0220: 68 65 0a 3b 3b 3b 20 20 20 20 20 66 6f 72 6d 20 he.;;; form 0230: 28 3c 63 61 74 3e 20 2d 2d 3e 20 3c 63 61 74 3e (<cat> --> <cat> 0240: 20 2e 2e 2e 20 3c 61 63 74 69 6f 6e 3e 29 2c 20 ... <action>), 0250: 77 68 65 72 65 20 3c 63 61 74 3e 20 69 73 20 61 where <cat> is a 0260: 20 73 79 6d 62 6f 6c 0a 3b 3b 3b 20 20 20 20 20 symbol.;;; 0270: 28 61 20 63 61 74 65 67 6f 72 79 20 6c 61 62 65 (a category labe 0280: 6c 29 20 61 6e 64 20 3c 61 63 74 69 6f 6e 3e 20 l) and <action> 0290: 69 73 20 61 20 70 72 6f 63 65 64 75 72 65 20 6f is a procedure o 02a0: 66 20 61 70 70 72 6f 70 72 69 61 74 65 0a 3b 3b f appropriate.;; 02b0: 3b 20 20 20 20 20 61 72 69 74 79 2e 20 20 54 68 ; arity. Th 02c0: 65 20 70 72 6f 63 65 64 75 72 65 20 77 69 6c 6c e procedure will 02d0: 20 62 65 20 63 61 6c 6c 65 64 20 65 61 63 68 20 be called each 02e0: 74 69 6d 65 20 74 68 69 73 20 70 72 6f 64 75 63 time this produc 02f0: 74 69 6f 6e 0a 3b 3b 3b 20 20 20 20 20 69 73 20 tion.;;; is 0300: 72 65 64 75 63 65 64 20 77 69 74 68 20 74 68 65 reduced with the 0310: 20 76 61 6c 75 65 73 20 61 73 73 6f 63 69 61 74 values associat 0320: 65 64 20 77 69 74 68 20 65 61 63 68 20 63 68 69 ed with each chi 0330: 6c 64 20 6e 6f 64 65 2e 0a 3b 3b 3b 20 20 20 20 ld node..;;; 0340: 20 54 68 65 20 63 61 74 65 67 6f 72 69 65 73 20 The categories 0350: 63 61 6e 20 62 65 20 61 6e 79 20 73 79 6d 62 6f can be any symbo 0360: 6c 20 5f 65 78 63 65 70 74 5f 20 24 73 74 61 72 l _except_ $star 0370: 74 24 20 61 6e 64 20 24 65 6e 64 24 2e 0a 3b 3b t$ and $end$..;; 0380: 3b 20 20 20 20 20 54 68 65 20 67 72 61 6d 6d 61 ; The gramma 0390: 72 27 73 20 73 74 61 72 74 20 73 79 6d 62 6f 6c r's start symbol 03a0: 20 69 73 20 74 68 65 20 70 61 72 65 6e 74 20 63 is the parent c 03b0: 61 74 65 67 6f 72 79 20 6f 66 20 74 68 65 20 66 ategory of the f 03c0: 69 72 73 74 0a 3b 3b 3b 20 20 20 20 20 70 72 6f irst.;;; pro 03d0: 64 75 63 74 69 6f 6e 2c 20 69 2e 65 2e 2c 20 28 duction, i.e., ( 03e0: 63 61 61 72 20 67 72 61 6d 6d 61 72 29 2e 0a 3b caar grammar)..; 03f0: 3b 3b 0a 3b 3b 3b 20 20 20 74 65 72 6d 69 6e 61 ;;.;;; termina 0400: 6c 73 3a 20 41 20 6c 69 73 74 20 6f 66 20 61 6c ls: A list of al 0410: 6c 20 74 68 65 20 63 61 74 65 67 6f 72 69 65 73 l the categories 0420: 20 74 68 61 74 20 74 68 65 20 6c 65 78 69 63 61 that the lexica 0430: 6c 20 61 6e 61 6c 79 73 65 72 0a 3b 3b 3b 20 20 l analyser.;;; 0440: 20 20 20 63 61 6e 20 72 65 74 75 72 6e 2e 0a 3b can return..; 0450: 3b 3b 0a 3b 3b 3b 20 20 20 70 72 69 6e 74 2d 74 ;;.;;; print-t 0460: 61 62 6c 65 2d 66 6c 61 67 3a 20 49 66 20 6e 6f able-flag: If no 0470: 6e 2d 23 66 2c 20 63 61 75 73 65 73 20 74 68 65 n-#f, causes the 0480: 20 70 72 65 74 74 79 2d 70 72 69 6e 74 69 6e 67 pretty-printing 0490: 20 6f 66 20 74 68 65 0a 3b 3b 3b 20 20 20 20 20 of the.;;; 04a0: 6c 61 6c 72 20 70 61 72 73 65 20 74 61 62 6c 65 lalr parse table 04b0: 73 20 61 73 20 61 20 73 69 64 65 2d 65 66 66 65 s as a side-effe 04c0: 63 74 2e 20 20 50 61 72 73 65 20 63 6f 6e 66 6c ct. Parse confl 04d0: 69 63 74 73 20 61 72 65 20 69 6e 64 69 63 61 74 icts are indicat 04e0: 65 64 0a 3b 3b 3b 20 20 20 20 20 69 6e 20 74 68 ed.;;; in th 04f0: 65 20 74 61 62 6c 65 20 28 73 65 61 72 63 68 20 e table (search 0500: 66 6f 72 20 2a 2a 20 29 2e 0a 3b 3b 3b 0a 3b 3b for ** )..;;;.;; 0510: 3b 20 28 6c 61 6c 72 2d 70 61 72 73 65 72 20 74 ; (lalr-parser t 0520: 61 62 6c 65 20 6c 65 78 69 63 61 6c 2d 61 6e 61 able lexical-ana 0530: 6c 79 73 65 72 20 70 61 72 73 65 2d 65 72 72 6f lyser parse-erro 0540: 72 29 20 72 65 74 75 72 6e 73 20 74 68 65 20 76 r) returns the v 0550: 61 6c 75 65 0a 3b 3b 3b 20 61 73 73 6f 63 69 61 alue.;;; associa 0560: 74 65 64 20 77 69 74 68 20 74 68 65 20 72 6f 6f ted with the roo 0570: 74 20 6e 6f 64 65 20 69 66 20 74 68 65 20 70 61 t node if the pa 0580: 72 73 65 20 69 73 20 73 75 63 63 65 73 73 66 75 rse is successfu 0590: 6c 2c 20 6f 72 20 74 68 65 0a 3b 3b 3b 20 76 61 l, or the.;;; va 05a0: 6c 75 65 20 6f 66 20 70 61 72 73 65 2d 65 72 72 lue of parse-err 05b0: 6f 72 20 6f 74 68 65 72 77 69 73 65 2e 0a 3b 3b or otherwise..;; 05c0: 3b 0a 3b 3b 3b 20 20 74 61 62 6c 65 3a 20 41 20 ;.;;; table: A 05d0: 70 61 72 73 65 20 74 61 62 6c 65 20 70 72 6f 64 parse table prod 05e0: 75 63 65 64 20 62 79 20 6c 61 6c 72 2d 74 61 62 uced by lalr-tab 05f0: 6c 65 2e 0a 3b 3b 3b 0a 3b 3b 3b 20 20 6c 65 78 le..;;;.;;; lex 0600: 69 63 61 6c 2d 61 6e 61 6c 79 73 65 72 3a 20 41 ical-analyser: A 0610: 20 70 72 6f 63 65 64 75 72 65 20 6f 66 20 6e 6f procedure of no 0620: 20 61 72 67 75 6d 65 6e 74 73 20 77 68 69 63 68 arguments which 0630: 20 61 64 76 61 6e 63 65 73 20 74 68 65 0a 3b 3b advances the.;; 0640: 3b 20 20 20 20 20 69 6e 70 75 74 20 73 74 72 65 ; input stre 0650: 61 6d 20 62 79 20 6f 6e 65 20 65 6c 65 6d 65 6e am by one elemen 0660: 74 20 65 61 63 68 20 74 69 6d 65 20 69 74 20 69 t each time it i 0670: 73 20 63 61 6c 6c 65 64 2c 20 72 65 74 75 72 6e s called, return 0680: 69 6e 67 0a 3b 3b 3b 20 20 20 20 20 28 63 6f 6e ing.;;; (con 0690: 73 20 3c 63 61 74 3e 20 3c 76 61 6c 3e 29 20 77 s <cat> <val>) w 06a0: 68 65 72 65 20 3c 63 61 74 3e 20 69 73 20 74 68 here <cat> is th 06b0: 65 20 63 61 74 65 67 6f 72 79 20 6c 61 62 65 6c e category label 06c0: 20 6f 66 20 74 68 65 20 0a 3b 3b 3b 20 20 20 20 of the .;;; 06d0: 20 6e 65 78 74 20 74 6f 6b 65 6e 2c 20 61 6e 64 next token, and 06e0: 20 3c 76 61 6c 3e 20 69 73 20 74 68 65 20 76 61 <val> is the va 06f0: 6c 75 65 20 61 73 73 6f 63 69 61 74 65 64 20 77 lue associated w 0700: 69 74 68 20 74 68 61 74 20 74 6f 6b 65 6e 2e 0a ith that token.. 0710: 3b 3b 3b 20 20 20 20 20 49 74 20 73 68 6f 75 6c ;;; It shoul 0720: 64 20 72 65 74 75 72 6e 20 23 66 20 61 74 20 74 d return #f at t 0730: 68 65 20 65 6e 64 20 6f 66 20 74 68 65 20 69 6e he end of the in 0740: 70 75 74 20 73 74 72 65 61 6d 2e 0a 3b 3b 3b 0a put stream..;;;. 0750: 3b 3b 3b 20 20 70 61 72 73 65 2d 65 72 72 6f 72 ;;; parse-error 0760: 3a 20 41 20 70 72 6f 63 65 64 75 72 65 20 6f 66 : A procedure of 0770: 20 6e 6f 20 61 72 67 75 6d 65 6e 74 73 2c 20 77 no arguments, w 0780: 68 69 63 68 20 69 73 20 63 61 6c 6c 65 64 20 69 hich is called i 0790: 66 20 74 68 65 0a 3b 3b 3b 20 20 20 20 20 74 68 f the.;;; th 07a0: 65 20 70 61 72 73 65 72 20 62 6c 6f 63 6b 73 20 e parser blocks 07b0: 28 69 2e 65 2e 2c 20 64 65 74 65 63 74 73 20 61 (i.e., detects a 07c0: 20 73 79 6e 74 61 63 74 69 63 20 65 72 72 6f 72 syntactic error 07d0: 20 69 6e 20 74 68 65 20 69 6e 70 75 74 0a 3b 3b in the input.;; 07e0: 3b 20 20 20 20 20 73 74 72 65 61 6d 29 2e 0a 3b ; stream)..; 07f0: 3b 3b 0a 3b 3b 3b 0a 3b 3b 3b 20 20 54 68 65 20 ;;.;;;.;;; The 0800: 70 61 72 73 65 72 20 72 65 73 6f 6c 76 65 73 20 parser resolves 0810: 61 6e 79 20 70 61 72 73 65 20 63 6f 6e 66 6c 69 any parse confli 0820: 63 74 73 20 69 6e 20 61 20 73 74 61 6e 64 61 72 cts in a standar 0830: 64 20 77 61 79 3b 0a 3b 3b 3b 20 20 73 68 69 66 d way;.;;; shif 0840: 74 2f 72 65 64 75 63 65 20 63 6f 6e 66 6c 69 63 t/reduce conflic 0850: 74 73 20 61 72 65 20 72 65 73 6f 6c 76 65 64 20 ts are resolved 0860: 62 79 20 73 68 69 66 74 69 6e 67 2c 20 61 6e 64 by shifting, and 0870: 20 72 65 64 75 63 65 2f 72 65 64 75 63 65 0a 3b reduce/reduce.; 0880: 3b 3b 20 20 63 6f 6e 66 6c 69 63 74 73 20 61 72 ;; conflicts ar 0890: 65 20 72 65 73 6f 6c 76 65 64 20 62 79 20 63 68 e resolved by ch 08a0: 6f 6f 73 69 6e 67 20 74 68 65 20 6c 6f 6e 67 65 oosing the longe 08b0: 73 74 20 61 70 70 6c 69 63 61 62 6c 65 0a 3b 3b st applicable.;; 08c0: 3b 20 20 72 65 64 75 63 74 69 6f 6e 2e 0a 3b 3b ; reduction..;; 08d0: 3b 0a 3b 3b 3b 20 20 4e 6f 74 65 3a 20 49 74 20 ;.;;; Note: It 08e0: 69 73 20 6d 6f 73 74 20 63 6f 6e 76 65 6e 69 65 is most convenie 08f0: 6e 74 20 74 6f 20 75 73 65 20 74 68 65 20 62 61 nt to use the ba 0900: 63 6b 71 75 6f 74 65 20 6d 65 63 68 61 6e 69 73 ckquote mechanis 0910: 6d 20 74 6f 0a 3b 3b 3b 20 20 65 6e 74 65 72 20 m to.;;; enter 0920: 74 68 65 20 67 72 61 6d 6d 61 72 20 69 6e 74 6f the grammar into 0930: 20 73 63 68 65 6d 65 2e 20 20 54 68 65 20 61 63 scheme. The ac 0940: 74 69 6f 6e 73 2c 20 77 68 69 63 68 20 61 72 65 tions, which are 0950: 20 70 72 6f 63 65 64 75 72 65 73 2c 0a 3b 3b 3b procedures,.;;; 0960: 20 20 63 61 6e 20 62 65 20 63 72 65 61 74 65 64 can be created 0970: 20 62 79 20 75 6e 71 75 6f 74 69 6e 67 20 61 20 by unquoting a 0980: 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 6c 61 corresponding la 0990: 6d 62 64 61 20 65 78 70 72 65 73 73 69 6f 6e 0a mbda expression. 09a0: 3b 3b 3b 20 20 28 73 65 65 20 74 68 65 20 61 73 ;;; (see the as 09b0: 73 6f 63 69 61 74 65 64 20 65 78 61 6d 70 6c 65 sociated example 09c0: 20 66 69 6c 65 29 2e 20 20 59 6f 75 20 63 61 6e file). You can 09d0: 20 75 73 65 20 6c 61 6c 72 2d 74 61 62 6c 65 20 use lalr-table 09e0: 74 6f 0a 3b 3b 3b 20 20 70 72 6f 64 75 63 65 20 to.;;; produce 09f0: 65 78 70 72 65 73 73 69 6f 6e 73 20 74 68 61 74 expressions that 0a00: 20 63 61 6e 20 61 70 70 65 61 72 20 69 6e 20 53 can appear in S 0a10: 63 68 65 6d 65 20 70 72 6f 67 72 61 6d 73 20 62 cheme programs b 0a20: 79 20 63 68 61 6e 67 69 6e 67 20 0a 3b 3b 3b 20 y changing .;;; 0a30: 20 74 68 65 20 62 61 63 6b 71 75 6f 74 65 20 69 the backquote i 0a40: 6e 66 72 6f 6e 74 20 6f 66 20 74 68 65 20 67 72 nfront of the gr 0a50: 61 6d 6d 61 72 20 74 6f 20 61 20 6e 6f 72 6d 61 ammar to a norma 0a60: 6c 20 71 75 6f 74 65 2e 0a 0a 3b 3b 3b 20 28 72 l quote...;;; (r 0a70: 65 71 75 69 72 65 20 27 73 6f 72 74 29 0a 3b 3b equire 'sort).;; 0a80: 3b 20 28 72 65 71 75 69 72 65 20 27 61 73 73 6f ; (require 'asso 0a90: 63 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 6c c)..(define (lal 0aa0: 72 2d 74 61 62 6c 65 20 67 72 61 6d 6d 61 72 20 r-table grammar 0ab0: 74 65 72 6d 69 6e 61 6c 73 20 70 72 69 6e 74 2d terminals print- 0ac0: 66 6c 61 67 29 0a 20 20 0a 20 20 28 64 65 66 69 flag). . (defi 0ad0: 6e 65 20 6e 65 77 2d 73 74 61 72 74 2d 73 79 6d ne new-start-sym 0ae0: 62 6f 6c 20 27 24 73 74 61 72 74 24 29 0a 20 20 bol '$start$). 0af0: 28 64 65 66 69 6e 65 20 65 6e 64 2d 6d 61 72 6b (define end-mark 0b00: 65 72 20 27 24 65 6e 64 24 29 0a 0a 3b 3b 3b 3b er '$end$)..;;;; 0b10: 3b 3b 3b 20 55 74 69 6c 69 74 69 65 73 0a 0a 20 ;;; Utilities.. 0b20: 20 28 64 65 66 69 6e 65 20 28 6c 69 73 74 2d 70 (define (list-p 0b30: 72 65 66 69 78 20 65 6c 74 73 20 6e 29 0a 20 20 refix elts n). 0b40: 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 6e 29 0a (if (zero? n). 0b50: 09 27 28 29 0a 09 28 63 6f 6e 73 20 28 63 61 72 .'()..(cons (car 0b60: 20 65 6c 74 73 29 20 28 6c 69 73 74 2d 70 72 65 elts) (list-pre 0b70: 66 69 78 20 28 63 64 72 20 65 6c 74 73 29 20 28 fix (cdr elts) ( 0b80: 2d 20 6e 20 31 29 29 29 29 29 0a 0a 20 20 28 64 - n 1))))).. (d 0b90: 65 66 69 6e 65 20 28 6c 69 73 74 2d 73 75 66 66 efine (list-suff 0ba0: 69 78 20 65 6c 74 73 20 6e 29 0a 20 20 20 20 28 ix elts n). ( 0bb0: 69 66 20 28 7a 65 72 6f 3f 20 6e 29 0a 09 65 6c if (zero? n)..el 0bc0: 74 73 0a 09 28 6c 69 73 74 2d 73 75 66 66 69 78 ts..(list-suffix 0bd0: 20 28 63 64 72 20 65 6c 74 73 29 20 28 2d 20 6e (cdr elts) (- n 0be0: 20 31 29 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 1)))).. (defin 0bf0: 65 20 28 73 75 62 6c 69 73 74 20 65 6c 74 73 20 e (sublist elts 0c00: 73 74 61 72 74 20 2e 20 65 6e 64 29 0a 20 20 20 start . end). 0c10: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 65 6e 64 29 (if (null? end) 0c20: 0a 09 28 6c 69 73 74 2d 73 75 66 66 69 78 20 65 ..(list-suffix e 0c30: 6c 74 73 20 73 74 61 72 74 29 0a 09 28 6c 69 73 lts start)..(lis 0c40: 74 2d 70 72 65 66 69 78 20 28 6c 69 73 74 2d 73 t-prefix (list-s 0c50: 75 66 66 69 78 20 65 6c 74 73 20 73 74 61 72 74 uffix elts start 0c60: 29 20 28 2d 20 28 63 61 72 20 65 6e 64 29 20 73 ) (- (car end) s 0c70: 74 61 72 74 29 29 29 29 0a 0a 20 20 28 64 65 66 tart)))).. (def 0c80: 69 6e 65 20 28 62 75 74 6c 61 73 74 20 65 6c 74 ine (butlast elt 0c90: 73 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 6e s). (cond ((n 0ca0: 75 6c 6c 3f 20 65 6c 74 73 29 20 27 28 29 29 0a ull? elts) '()). 0cb0: 09 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 20 . ((null? (cdr 0cc0: 65 6c 74 73 29 29 20 27 28 29 29 0a 09 20 20 28 elts)) '()).. ( 0cd0: 65 6c 73 65 20 28 63 6f 6e 73 20 28 63 61 72 20 else (cons (car 0ce0: 65 6c 74 73 29 20 28 62 75 74 6c 61 73 74 20 28 elts) (butlast ( 0cf0: 63 64 72 20 65 6c 74 73 29 29 29 29 29 29 0a 0a cdr elts)))))).. 0d00: 20 20 28 64 65 66 69 6e 65 20 28 6c 61 73 74 20 (define (last 0d10: 65 6c 74 73 29 0a 20 20 20 20 28 63 6f 6e 64 20 elts). (cond 0d20: 28 28 6e 75 6c 6c 3f 20 65 6c 74 73 29 20 23 66 ((null? elts) #f 0d30: 29 0a 09 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 ).. ((null? (cd 0d40: 72 20 65 6c 74 73 29 29 20 28 63 61 72 20 65 6c r elts)) (car el 0d50: 74 73 29 29 0a 09 20 20 28 65 6c 73 65 20 28 6c ts)).. (else (l 0d60: 61 73 74 20 28 63 64 72 20 65 6c 74 73 29 29 29 ast (cdr elts))) 0d70: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 73 )).. (define (s 0d80: 65 6c 65 63 74 20 70 3f 20 65 73 29 0a 20 20 20 elect p? es). 0d90: 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 65 (cond ((null? e 0da0: 73 29 20 27 28 29 29 0a 09 20 20 28 28 70 3f 20 s) '()).. ((p? 0db0: 28 63 61 72 20 65 73 29 29 20 28 63 6f 6e 73 20 (car es)) (cons 0dc0: 28 63 61 72 20 65 73 29 20 28 73 65 6c 65 63 74 (car es) (select 0dd0: 20 70 3f 20 28 63 64 72 20 65 73 29 29 29 29 0a p? (cdr es)))). 0de0: 09 20 20 28 65 6c 73 65 20 28 73 65 6c 65 63 74 . (else (select 0df0: 20 70 3f 20 28 63 64 72 20 65 73 29 29 29 29 29 p? (cdr es))))) 0e00: 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 66 69 6e .. (define (fin 0e10: 64 2d 69 66 20 70 3f 20 65 73 29 0a 20 20 20 20 d-if p? es). 0e20: 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 65 73 (cond ((null? es 0e30: 29 20 23 66 29 0a 09 20 20 28 28 70 3f 20 28 63 ) #f).. ((p? (c 0e40: 61 72 20 65 73 29 29 20 28 63 61 72 20 65 73 29 ar es)) (car es) 0e50: 29 0a 09 20 20 28 65 6c 73 65 20 28 66 69 6e 64 ).. (else (find 0e60: 2d 69 66 20 70 3f 20 28 63 64 72 20 65 73 29 29 -if p? (cdr es)) 0e70: 29 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 ))).. (define ( 0e80: 73 6f 6d 65 20 70 3f 20 65 73 29 0a 20 20 20 20 some p? es). 0e90: 28 69 66 20 28 6e 75 6c 6c 3f 20 65 73 29 0a 09 (if (null? es).. 0ea0: 23 66 0a 09 28 6f 72 20 28 70 3f 20 28 63 61 72 #f..(or (p? (car 0eb0: 20 65 73 29 29 0a 09 20 20 20 20 28 73 6f 6d 65 es)).. (some 0ec0: 20 70 3f 20 28 63 64 72 20 65 73 29 29 29 29 29 p? (cdr es))))) 0ed0: 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 65 76 65 .. (define (eve 0ee0: 72 79 20 70 3f 20 65 73 29 0a 20 20 20 20 28 69 ry p? es). (i 0ef0: 66 20 28 6e 75 6c 6c 3f 20 65 73 29 0a 09 23 74 f (null? es)..#t 0f00: 0a 09 28 61 6e 64 20 28 70 3f 20 28 63 61 72 20 ..(and (p? (car 0f10: 65 73 29 29 0a 09 20 20 20 20 20 28 65 76 65 72 es)).. (ever 0f20: 79 20 70 3f 20 28 63 64 72 20 65 73 29 29 29 29 y p? (cdr es)))) 0f30: 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 72 65 ).. (define (re 0f40: 64 75 63 65 20 66 20 65 73 20 69 6e 69 74 29 0a duce f es init). 0f50: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 65 (if (null? e 0f60: 73 29 0a 09 69 6e 69 74 0a 09 28 72 65 64 75 63 s)..init..(reduc 0f70: 65 20 66 20 28 63 64 72 20 65 73 29 20 28 66 20 e f (cdr es) (f 0f80: 28 63 61 72 20 65 73 29 20 69 6e 69 74 29 29 29 (car es) init))) 0f90: 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 75 6e ).. (define (un 0fa0: 69 6f 6e 20 65 31 73 20 65 32 73 29 0a 20 20 20 ion e1s e2s). 0fb0: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 65 31 73 29 (if (null? e1s) 0fc0: 0a 09 65 32 73 0a 09 28 69 66 20 28 6d 65 6d 62 ..e2s..(if (memb 0fd0: 65 72 20 28 63 61 72 20 65 31 73 29 20 65 32 73 er (car e1s) e2s 0fe0: 29 0a 09 20 20 20 20 28 75 6e 69 6f 6e 20 28 63 ).. (union (c 0ff0: 64 72 20 65 31 73 29 20 65 32 73 29 0a 09 20 20 dr e1s) e2s).. 1000: 20 20 28 63 6f 6e 73 20 28 63 61 72 20 65 31 73 (cons (car e1s 1010: 29 20 28 75 6e 69 6f 6e 20 28 63 64 72 20 65 31 ) (union (cdr e1 1020: 73 29 20 65 32 73 29 29 29 29 29 0a 0a 20 20 28 s) e2s))))).. ( 1030: 64 65 66 69 6e 65 20 28 69 6e 74 65 72 73 65 63 define (intersec 1040: 74 69 6f 6e 20 65 31 73 20 65 32 73 29 0a 20 20 tion e1s e2s). 1050: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 65 31 73 (if (null? e1s 1060: 29 0a 09 27 28 29 0a 09 28 69 66 20 28 6d 65 6d )..'()..(if (mem 1070: 62 65 72 20 28 63 61 72 20 65 31 73 29 20 65 32 ber (car e1s) e2 1080: 73 29 0a 09 20 20 20 20 28 63 6f 6e 73 20 28 63 s).. (cons (c 1090: 61 72 20 65 31 73 29 20 28 69 6e 74 65 72 73 65 ar e1s) (interse 10a0: 63 74 69 6f 6e 20 28 63 64 72 20 65 31 73 29 20 ction (cdr e1s) 10b0: 65 32 73 29 29 0a 09 20 20 20 20 28 69 6e 74 65 e2s)).. (inte 10c0: 72 73 65 63 74 69 6f 6e 20 28 63 64 72 20 65 31 rsection (cdr e1 10d0: 73 29 20 65 32 73 29 29 29 29 0a 0a 20 20 28 64 s) e2s)))).. (d 10e0: 65 66 69 6e 65 20 28 73 75 62 74 72 61 63 74 20 efine (subtract 10f0: 65 31 73 20 65 32 73 29 0a 20 20 20 20 28 69 66 e1s e2s). (if 1100: 20 28 6e 75 6c 6c 3f 20 65 31 73 29 0a 09 27 28 (null? e1s)..'( 1110: 29 0a 09 28 69 66 20 28 6d 65 6d 62 65 72 20 28 )..(if (member ( 1120: 63 61 72 20 65 31 73 29 20 65 32 73 29 0a 09 20 car e1s) e2s).. 1130: 20 20 20 28 73 75 62 74 72 61 63 74 20 28 63 64 (subtract (cd 1140: 72 20 65 31 73 29 20 65 32 73 29 0a 09 20 20 20 r e1s) e2s).. 1150: 20 28 63 6f 6e 73 20 28 63 61 72 20 65 31 73 29 (cons (car e1s) 1160: 20 28 73 75 62 74 72 61 63 74 20 28 63 64 72 20 (subtract (cdr 1170: 65 31 73 29 20 65 32 73 29 29 29 29 29 0a 0a 20 e1s) e2s))))).. 1180: 20 28 64 65 66 69 6e 65 20 28 75 6e 69 6f 6e 73 (define (unions 1190: 20 73 65 74 73 29 0a 20 20 20 20 28 63 6f 6e 64 sets). (cond 11a0: 20 28 28 6e 75 6c 6c 3f 20 73 65 74 73 29 20 27 ((null? sets) ' 11b0: 28 29 29 0a 09 20 20 28 28 6e 75 6c 6c 3f 20 28 ()).. ((null? ( 11c0: 63 64 72 20 73 65 74 73 29 29 20 28 63 61 72 20 cdr sets)) (car 11d0: 73 65 74 73 29 29 0a 09 20 20 28 65 6c 73 65 20 sets)).. (else 11e0: 28 75 6e 69 6f 6e 20 28 63 61 72 20 73 65 74 73 (union (car sets 11f0: 29 20 28 75 6e 69 6f 6e 73 20 28 63 64 72 20 73 ) (unions (cdr s 1200: 65 74 73 29 29 29 29 29 29 0a 0a 20 20 28 64 65 ets)))))).. (de 1210: 66 69 6e 65 20 28 63 6c 6f 73 65 20 6f 70 20 65 fine (close op e 1220: 73 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 s). (define ( 1230: 63 6c 6f 73 65 31 20 74 6f 64 6f 20 73 6f 66 61 close1 todo sofa 1240: 72 29 0a 20 20 20 20 20 20 28 69 66 20 28 70 61 r). (if (pa 1250: 69 72 3f 20 74 6f 64 6f 29 0a 09 20 20 28 63 6c ir? todo).. (cl 1260: 6f 73 65 31 20 28 63 64 72 20 74 6f 64 6f 29 0a ose1 (cdr todo). 1270: 09 09 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 .. (if (member 1280: 28 63 61 72 20 74 6f 64 6f 29 20 73 6f 66 61 72 (car todo) sofar 1290: 29 0a 09 09 20 20 20 20 20 20 73 6f 66 61 72 0a )... sofar. 12a0: 09 09 20 20 20 20 20 20 28 63 6c 6f 73 65 31 20 .. (close1 12b0: 28 6f 70 20 28 63 61 72 20 74 6f 64 6f 29 29 20 (op (car todo)) 12c0: 28 63 6f 6e 73 20 28 63 61 72 20 74 6f 64 6f 29 (cons (car todo) 12d0: 20 73 6f 66 61 72 29 29 29 29 0a 09 20 20 73 6f sofar)))).. so 12e0: 66 61 72 29 29 0a 20 20 20 20 28 63 6c 6f 73 65 far)). (close 12f0: 31 20 65 73 20 27 28 29 29 29 0a 0a 20 20 28 64 1 es '())).. (d 1300: 65 66 69 6e 65 20 28 63 6f 6c 6c 65 63 74 20 66 efine (collect f 1310: 20 65 73 29 0a 20 20 20 20 28 64 65 66 69 6e 65 es). (define 1320: 20 28 63 6f 6c 6c 65 63 74 31 20 74 6f 64 6f 20 (collect1 todo 1330: 73 6f 66 61 72 29 0a 20 20 20 20 20 20 28 69 66 sofar). (if 1340: 20 28 6e 75 6c 6c 3f 20 74 6f 64 6f 29 0a 09 20 (null? todo).. 1350: 20 73 6f 66 61 72 0a 09 20 20 28 6c 65 74 20 28 sofar.. (let ( 1360: 28 76 61 6c 20 28 66 20 28 63 61 72 20 74 6f 64 (val (f (car tod 1370: 6f 29 29 29 29 0a 09 20 20 20 20 28 63 6f 6c 6c o)))).. (coll 1380: 65 63 74 31 20 28 63 64 72 20 74 6f 64 6f 29 20 ect1 (cdr todo) 1390: 28 69 66 20 76 61 6c 20 28 61 64 6a 6f 69 6e 20 (if val (adjoin 13a0: 76 61 6c 20 73 6f 66 61 72 29 20 73 6f 66 61 72 val sofar) sofar 13b0: 29 29 29 29 29 0a 20 20 20 20 28 63 6f 6c 6c 65 ))))). (colle 13c0: 63 74 31 20 65 73 20 27 28 29 29 29 0a 0a 20 20 ct1 es '())).. 13d0: 28 64 65 66 69 6e 65 20 28 61 64 6a 6f 69 6e 20 (define (adjoin 13e0: 65 20 65 73 29 0a 20 20 20 20 28 69 66 20 28 6d e es). (if (m 13f0: 65 6d 62 65 72 20 65 20 65 73 29 0a 09 65 73 0a ember e es)..es. 1400: 09 28 63 6f 6e 73 20 65 20 65 73 29 29 29 0a 0a .(cons e es))).. 1410: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1420: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1430: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1440: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1450: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b ;;;;;;;;;;;;.;;; 1460: 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 .;;; 1470: 20 20 20 20 20 20 20 20 47 6c 6f 62 61 6c 73 0a Globals. 1480: 3b 3b 3b 0a 0a 20 20 28 64 65 66 69 6e 65 20 63 ;;;.. (define c 1490: 61 74 40 20 61 74 6f 6d 40 29 0a 0a 20 20 28 64 at@ atom@).. (d 14a0: 65 66 69 6e 65 20 6d 65 6d 6f 69 7a 65 31 0a 20 efine memoize1. 14b0: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 73 73 6f (lambda (asso 14c0: 63 2d 6d 61 6b 65 72 20 66 6e 29 0a 20 20 20 20 c-maker fn). 14d0: 20 20 28 6c 65 74 2a 20 28 28 73 74 6f 72 65 20 (let* ((store 14e0: 28 28 61 73 73 6f 63 2d 6d 61 6b 65 72 20 27 6d ((assoc-maker 'm 14f0: 61 6b 65 29 29 29 0a 09 20 20 20 20 20 28 72 65 ake))).. (re 1500: 66 20 28 61 73 73 6f 63 2d 6d 61 6b 65 72 20 27 f (assoc-maker ' 1510: 72 65 66 29 29 0a 09 20 20 20 20 20 28 73 65 74 ref)).. (set 1520: 74 65 72 21 20 28 61 73 73 6f 63 2d 6d 61 6b 65 ter! (assoc-make 1530: 72 20 27 73 65 74 21 29 29 29 0a 09 28 6c 61 6d r 'set!)))..(lam 1540: 62 64 61 20 28 61 72 67 29 0a 09 20 20 28 6f 72 bda (arg).. (or 1550: 20 28 72 65 66 20 73 74 6f 72 65 20 61 72 67 29 (ref store arg) 1560: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 .. (let ((v 1570: 61 6c 20 28 66 6e 20 61 72 67 29 29 29 0a 09 09 al (fn arg)))... 1580: 28 73 65 74 74 65 72 21 20 73 74 6f 72 65 20 61 (setter! store a 1590: 72 67 20 76 61 6c 29 0a 09 09 76 61 6c 29 29 29 rg val)...val))) 15a0: 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b )))..;;;;;;;;;;; 15b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 15c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 15d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 15e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 15f0: 3b 0a 3b 3b 3b 0a 3b 3b 3b 20 20 20 20 20 20 20 ;.;;;.;;; 1600: 20 20 20 20 20 20 20 20 20 20 20 20 20 52 75 6c Rul 1610: 65 73 20 61 6e 64 20 47 72 61 6d 6d 61 72 73 0a es and Grammars. 1620: 3b 3b 3b 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 ;;;.. (define ( 1630: 6d 61 6b 65 2d 72 75 6c 65 20 69 6e 64 65 78 2d make-rule index- 1640: 6e 75 6d 62 65 72 20 6d 6f 74 68 65 72 20 64 61 number mother da 1650: 75 67 68 74 65 72 73 20 61 63 74 69 6f 6e 29 0a ughters action). 1660: 20 20 20 20 28 76 65 63 74 6f 72 20 69 6e 64 65 (vector inde 1670: 78 2d 6e 75 6d 62 65 72 20 6d 6f 74 68 65 72 20 x-number mother 1680: 64 61 75 67 68 74 65 72 73 20 61 63 74 69 6f 6e daughters action 1690: 29 29 0a 0a 20 20 28 64 65 66 69 6e 65 20 28 72 )).. (define (r 16a0: 75 6c 65 2d 6e 6f 20 72 75 6c 65 29 20 28 76 65 ule-no rule) (ve 16b0: 63 74 6f 72 2d 72 65 66 20 72 75 6c 65 20 30 29 ctor-ref rule 0) 16c0: 29 0a 20 20 28 64 65 66 69 6e 65 20 28 72 75 6c ). (define (rul 16d0: 65 2d 6d 6f 74 68 65 72 20 72 75 6c 65 29 20 28 e-mother rule) ( 16e0: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6c 65 20 vector-ref rule 16f0: 31 29 29 0a 20 20 28 64 65 66 69 6e 65 20 28 72 1)). (define (r 1700: 75 6c 65 2d 64 61 75 67 68 74 65 72 73 20 72 75 ule-daughters ru 1710: 6c 65 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 le) (vector-ref 1720: 72 75 6c 65 20 32 29 29 0a 20 20 28 64 65 66 69 rule 2)). (defi 1730: 6e 65 20 28 72 75 6c 65 2d 61 63 74 69 6f 6e 20 ne (rule-action 1740: 72 75 6c 65 29 20 28 76 65 63 74 6f 72 2d 72 65 rule) (vector-re 1750: 66 20 72 75 6c 65 20 33 29 29 0a 0a 20 20 28 64 f rule 3)).. (d 1760: 65 66 69 6e 65 20 28 74 72 61 6e 73 66 6f 72 6d efine (transform 1770: 2d 72 75 6c 65 20 67 72 61 6d 6d 61 72 2d 72 75 -rule grammar-ru 1780: 6c 65 20 72 75 6c 65 2d 6e 6f 29 0a 20 20 20 20 le rule-no). 1790: 28 6c 65 74 20 28 28 6c 20 28 6c 65 6e 67 74 68 (let ((l (length 17a0: 20 67 72 61 6d 6d 61 72 2d 72 75 6c 65 29 29 29 grammar-rule))) 17b0: 0a 20 20 20 20 20 20 28 6d 61 6b 65 2d 72 75 6c . (make-rul 17c0: 65 20 72 75 6c 65 2d 6e 6f 20 28 63 61 72 20 67 e rule-no (car g 17d0: 72 61 6d 6d 61 72 2d 72 75 6c 65 29 20 0a 09 09 rammar-rule) ... 17e0: 20 28 62 75 74 6c 61 73 74 20 28 63 64 64 72 20 (butlast (cddr 17f0: 67 72 61 6d 6d 61 72 2d 72 75 6c 65 29 29 0a 09 grammar-rule)).. 1800: 09 20 28 6c 61 73 74 20 67 72 61 6d 6d 61 72 2d . (last grammar- 1810: 72 75 6c 65 29 29 29 29 0a 0a 0a 20 20 28 6c 65 rule))))... (le 1820: 74 2a 20 28 28 67 72 75 6c 65 73 20 28 6c 65 74 t* ((grules (let 1830: 20 28 28 69 20 2d 31 29 29 0a 09 09 20 20 20 28 ((i -1))... ( 1840: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 29 0a map (lambda (r). 1850: 09 09 09 20 20 28 73 65 74 21 20 69 20 28 31 2b ... (set! i (1+ 1860: 20 69 29 29 0a 09 09 09 20 20 28 74 72 61 6e 73 i)).... (trans 1870: 66 6f 72 6d 2d 72 75 6c 65 20 72 20 69 29 29 0a form-rule r i)). 1880: 09 09 09 67 72 61 6d 6d 61 72 29 29 29 0a 09 20 ...grammar))).. 1890: 28 6e 72 75 6c 65 73 20 28 6c 65 6e 67 74 68 20 (nrules (length 18a0: 67 72 75 6c 65 73 29 29 0a 09 20 28 6e 6f 6e 74 grules)).. (nont 18b0: 65 72 6d 69 6e 61 6c 73 20 28 63 6f 6c 6c 65 63 erminals (collec 18c0: 74 20 72 75 6c 65 2d 6d 6f 74 68 65 72 20 67 72 t rule-mother gr 18d0: 75 6c 65 73 29 29 0a 0a 09 20 28 73 74 61 72 74 ules))... (start 18e0: 2d 73 79 6d 62 6f 6c 20 28 63 61 61 72 20 67 72 -symbol (caar gr 18f0: 61 6d 6d 61 72 29 29 0a 0a 09 20 28 65 78 70 61 ammar))... (expa 1900: 6e 64 0a 09 20 20 28 6d 65 6d 6f 69 7a 65 31 20 nd.. (memoize1 1910: 63 61 74 40 0a 09 09 20 20 20 20 28 6c 61 6d 62 cat@... (lamb 1920: 64 61 20 28 63 61 74 29 20 0a 09 09 20 20 20 20 da (cat) ... 1930: 20 20 28 73 65 6c 65 63 74 20 28 6c 61 6d 62 64 (select (lambd 1940: 61 20 28 72 75 6c 65 29 20 28 65 71 3f 20 28 72 a (rule) (eq? (r 1950: 75 6c 65 2d 6d 6f 74 68 65 72 20 72 75 6c 65 29 ule-mother rule) 1960: 20 63 61 74 29 29 0a 09 09 09 20 20 20 20 20 20 cat)).... 1970: 67 72 75 6c 65 73 29 29 29 29 0a 20 20 20 20 20 grules)))). 1980: 20 20 0a 09 20 28 67 63 61 74 73 20 28 75 6e 69 .. (gcats (uni 1990: 6f 6e 20 74 65 72 6d 69 6e 61 6c 73 20 28 63 6f on terminals (co 19a0: 6c 6c 65 63 74 20 72 75 6c 65 2d 6d 6f 74 68 65 llect rule-mothe 19b0: 72 20 67 72 75 6c 65 73 29 29 29 0a 0a 09 20 28 r grules)))... ( 19c0: 64 65 72 69 76 65 73 2d 65 70 73 69 6c 6f 6e 3f derives-epsilon? 19d0: 0a 09 20 20 28 6d 65 6d 6f 69 7a 65 31 20 63 61 .. (memoize1 ca 19e0: 74 40 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 61 t@... (lambda 19f0: 20 28 63 29 0a 09 09 20 20 20 20 20 20 28 64 65 (c)... (de 1a00: 66 69 6e 65 20 28 74 72 79 20 64 65 6a 61 56 75 fine (try dejaVu 1a10: 20 63 61 74 29 0a 09 09 09 28 61 6e 64 20 28 6e cat)....(and (n 1a20: 6f 74 20 28 6d 65 6d 62 65 72 20 63 61 74 20 64 ot (member cat d 1a30: 65 6a 61 56 75 29 29 0a 09 09 09 20 20 20 20 20 ejaVu)).... 1a40: 28 73 6f 6d 65 20 28 6c 61 6d 62 64 61 20 28 72 (some (lambda (r 1a50: 29 20 0a 09 09 09 09 20 20 20 20 20 28 65 76 65 ) ..... (eve 1a60: 72 79 20 28 6c 61 6d 62 64 61 20 28 63 31 29 20 ry (lambda (c1) 1a70: 28 74 72 79 20 28 63 6f 6e 73 20 63 61 74 20 64 (try (cons cat d 1a80: 65 6a 61 56 75 29 20 63 31 29 29 0a 09 09 09 09 ejaVu) c1))..... 1a90: 09 20 20 20 20 28 72 75 6c 65 2d 64 61 75 67 68 . (rule-daugh 1aa0: 74 65 72 73 20 72 29 29 29 0a 09 09 09 09 20 20 ters r)))..... 1ab0: 20 28 65 78 70 61 6e 64 20 63 61 74 29 29 29 29 (expand cat)))) 1ac0: 0a 09 09 20 20 20 20 20 20 28 74 72 79 20 27 28 ... (try '( 1ad0: 29 20 63 29 29 29 29 0a 0a 09 20 28 6c 65 66 74 ) c))))... (left 1ae0: 2d 63 6f 72 6e 65 72 73 20 28 6c 61 6d 62 64 61 -corners (lambda 1af0: 20 28 63 29 0a 09 09 09 20 28 72 65 64 75 63 65 (c).... (reduce 1b00: 20 28 6c 61 6d 62 64 61 20 28 72 75 6c 65 20 73 (lambda (rule s 1b10: 6f 66 61 72 29 0a 09 09 09 09 20 20 20 28 64 65 ofar)..... (de 1b20: 66 69 6e 65 20 28 73 6b 69 70 20 72 68 73 20 73 fine (skip rhs s 1b30: 6f 66 61 72 29 0a 09 09 09 09 20 20 20 20 20 28 ofar)..... ( 1b40: 69 66 20 28 6e 75 6c 6c 3f 20 72 68 73 29 0a 09 if (null? rhs).. 1b50: 09 09 09 09 20 73 6f 66 61 72 0a 09 09 09 09 09 .... sofar...... 1b60: 20 28 69 66 20 28 64 65 72 69 76 65 73 2d 65 70 (if (derives-ep 1b70: 73 69 6c 6f 6e 3f 20 28 63 61 72 20 72 68 73 29 silon? (car rhs) 1b80: 29 0a 09 09 09 09 09 20 20 20 20 20 28 73 6b 69 )...... (ski 1b90: 70 20 28 63 64 72 20 72 68 73 29 20 28 61 64 6a p (cdr rhs) (adj 1ba0: 6f 69 6e 20 28 63 61 72 20 72 68 73 29 20 73 6f oin (car rhs) so 1bb0: 66 61 72 29 29 0a 09 09 09 09 09 20 20 20 20 20 far))...... 1bc0: 28 61 64 6a 6f 69 6e 20 28 63 61 72 20 72 68 73 (adjoin (car rhs 1bd0: 29 20 73 6f 66 61 72 29 29 29 29 0a 09 09 09 09 ) sofar))))..... 1be0: 20 20 20 28 73 6b 69 70 20 28 72 75 6c 65 2d 64 (skip (rule-d 1bf0: 61 75 67 68 74 65 72 73 20 72 75 6c 65 29 20 73 aughters rule) s 1c00: 6f 66 61 72 29 29 0a 09 09 09 09 20 28 65 78 70 ofar))..... (exp 1c10: 61 6e 64 20 63 29 0a 09 09 09 09 20 27 28 29 29 and c)..... '()) 1c20: 29 29 0a 0a 09 20 28 6c 65 66 74 2d 6d 6f 73 74 ))... (left-most 1c30: 2d 74 65 72 6d 69 6e 61 6c 73 0a 09 20 20 28 6d -terminals.. (m 1c40: 65 6d 6f 69 7a 65 31 20 63 61 74 40 0a 09 09 20 emoize1 cat@... 1c50: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 30 29 0a (lambda (c0). 1c60: 09 09 20 20 20 20 20 20 28 73 65 6c 65 63 74 20 .. (select 1c70: 28 6c 61 6d 62 64 61 20 28 74 65 72 6d 29 20 0a (lambda (term) . 1c80: 09 09 09 09 28 6f 72 20 28 65 71 3f 20 65 6e 64 ....(or (eq? end 1c90: 2d 6d 61 72 6b 65 72 20 74 65 72 6d 29 20 28 6d -marker term) (m 1ca0: 65 6d 62 65 72 20 74 65 72 6d 20 74 65 72 6d 69 ember term termi 1cb0: 6e 61 6c 73 29 29 29 0a 09 09 09 20 20 20 20 20 nals))).... 1cc0: 20 28 63 6c 6f 73 65 20 6c 65 66 74 2d 63 6f 72 (close left-cor 1cd0: 6e 65 72 73 20 28 6c 69 73 74 20 63 30 29 29 29 ners (list c0))) 1ce0: 29 29 29 29 0a 20 20 20 20 20 20 20 0a 20 20 20 )))). . 1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1d00: 20 20 20 0a 20 20 20 20 28 64 65 66 69 6e 65 20 . (define 1d10: 28 6c 65 66 74 2d 6d 6f 73 74 20 63 61 74 4c 69 (left-most catLi 1d20: 73 74 29 0a 20 20 20 20 20 20 28 69 66 20 28 70 st). (if (p 1d30: 61 69 72 3f 20 63 61 74 4c 69 73 74 29 0a 09 20 air? catList).. 1d40: 20 28 69 66 20 28 64 65 72 69 76 65 73 2d 65 70 (if (derives-ep 1d50: 73 69 6c 6f 6e 3f 20 28 63 61 72 20 63 61 74 4c silon? (car catL 1d60: 69 73 74 29 29 0a 09 20 20 20 20 20 20 28 75 6e ist)).. (un 1d70: 69 6f 6e 20 28 6c 65 66 74 2d 6d 6f 73 74 2d 74 ion (left-most-t 1d80: 65 72 6d 69 6e 61 6c 73 20 28 63 61 72 20 63 61 erminals (car ca 1d90: 74 4c 69 73 74 29 29 0a 09 09 20 20 20 20 20 28 tList))... ( 1da0: 6c 65 66 74 2d 6d 6f 73 74 20 28 63 64 72 20 63 left-most (cdr c 1db0: 61 74 4c 69 73 74 29 29 29 0a 09 20 20 20 20 20 atList))).. 1dc0: 20 28 6c 65 66 74 2d 6d 6f 73 74 2d 74 65 72 6d (left-most-term 1dd0: 69 6e 61 6c 73 20 28 63 61 72 20 63 61 74 4c 69 inals (car catLi 1de0: 73 74 29 29 29 0a 09 20 20 27 28 29 29 29 0a 0a st))).. '())).. 1df0: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;; 1e00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1e10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1e20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;; 1e30: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b ;;;;;;;;;;;;;.;; 1e40: 3b 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;.;;; 1e50: 20 20 20 20 20 20 20 4c 52 28 30 29 20 70 61 72 LR(0) par 1e60: 73 69 6e 67 20 74 61 62 6c 65 20 63 6f 6e 73 74 sing table const 1e70: 72 75 63 74 6f 72 0a 3b 3b 3b 0a 0a 20 20 20 20 ructor.;;;.. 1e80: 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 2d 69 74 (define (make-it 1e90: 65 6d 20 72 75 6c 65 20 70 6f 73 29 20 28 76 65 em rule pos) (ve 1ea0: 63 74 6f 72 20 70 6f 73 20 72 75 6c 65 20 27 28 ctor pos rule '( 1eb0: 29 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 ))). (define 1ec0: 28 69 74 65 6d 2d 72 75 6c 65 20 69 74 65 6d 29 (item-rule item) 1ed0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 74 65 (vector-ref ite 1ee0: 6d 20 31 29 29 0a 20 20 20 20 28 64 65 66 69 6e m 1)). (defin 1ef0: 65 20 28 69 74 65 6d 2d 70 6f 73 20 69 74 65 6d e (item-pos item 1f00: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 74 ) (vector-ref it 1f10: 65 6d 20 30 29 29 0a 20 20 20 20 28 64 65 66 69 em 0)). (defi 1f20: 6e 65 20 28 69 74 65 6d 2d 6c 61 73 20 69 74 65 ne (item-las ite 1f30: 6d 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 m) (vector-ref i 1f40: 74 65 6d 20 32 29 29 0a 20 20 20 20 28 64 65 66 tem 2)). (def 1f50: 69 6e 65 20 28 69 74 65 6d 2d 6c 61 73 2d 70 75 ine (item-las-pu 1f60: 73 68 21 20 69 74 65 6d 20 6c 61 29 20 0a 20 20 sh! item la) . 1f70: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set! 1f80: 20 69 74 65 6d 20 32 20 28 63 6f 6e 73 20 6c 61 item 2 (cons la 1f90: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 74 65 (vector-ref ite 1fa0: 6d 20 32 29 29 29 29 0a 0a 20 20 20 20 28 64 65 m 2)))).. (de 1fb0: 66 69 6e 65 20 28 69 74 65 6d 2d 64 61 75 67 68 fine (item-daugh 1fc0: 74 65 72 73 20 69 74 65 6d 29 20 28 72 75 6c 65 ters item) (rule 1fd0: 2d 64 61 75 67 68 74 65 72 73 20 28 69 74 65 6d -daughters (item 1fe0: 2d 72 75 6c 65 20 69 74 65 6d 29 29 29 0a 20 20 -rule item))). 1ff0: 20 20 28 64 65 66 69 6e 65 20 28 69 74 65 6d 2d (define (item- 2000: 72 69 67 68 74 20 69 74 65 6d 29 20 28 6c 69 73 right item) (lis 2010: 74 2d 73 75 66 66 69 78 20 28 69 74 65 6d 2d 64 t-suffix (item-d 2020: 61 75 67 68 74 65 72 73 20 69 74 65 6d 29 20 28 aughters item) ( 2030: 69 74 65 6d 2d 70 6f 73 20 69 74 65 6d 29 29 29 item-pos item))) 2040: 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 69 74 . (define (it 2050: 65 6d 2d 6e 65 78 74 20 69 74 65 6d 29 0a 20 20 em-next item). 2060: 20 20 20 20 28 6c 65 74 20 28 28 72 68 73 20 28 (let ((rhs ( 2070: 69 74 65 6d 2d 72 69 67 68 74 20 69 74 65 6d 29 item-right item) 2080: 29 29 0a 09 28 69 66 20 28 70 61 69 72 3f 20 72 ))..(if (pair? r 2090: 68 73 29 20 28 63 61 72 20 72 68 73 29 20 23 66 hs) (car rhs) #f 20a0: 29 29 29 0a 0a 3b 3b 3b 28 64 65 66 69 6e 65 20 )))..;;;(define 20b0: 28 69 74 65 6d 3c 3f 20 69 74 65 6d 31 20 69 74 (item<? item1 it 20c0: 65 6d 32 29 0a 3b 3b 3b 20 20 28 6c 65 74 20 28 em2).;;; (let ( 20d0: 28 72 6e 31 20 28 72 75 6c 65 2d 6e 6f 20 28 69 (rn1 (rule-no (i 20e0: 74 65 6d 2d 72 75 6c 65 20 69 74 65 6d 31 29 29 tem-rule item1)) 20f0: 29 0a 3b 3b 3b 20 20 20 20 20 20 20 20 28 72 6e ).;;; (rn 2100: 32 20 28 72 75 6c 65 2d 6e 6f 20 28 69 74 65 6d 2 (rule-no (item 2110: 2d 72 75 6c 65 20 69 74 65 6d 32 29 29 29 29 0a -rule item2)))). 2120: 3b 3b 3b 20 20 20 20 28 63 6f 6e 64 20 28 28 3c ;;; (cond ((< 2130: 20 72 6e 31 20 72 6e 32 29 20 23 74 29 0a 3b 3b rn1 rn2) #t).;; 2140: 3b 20 20 20 20 20 20 20 20 20 20 28 28 3e 20 72 ; ((> r 2150: 6e 31 20 72 6e 32 29 20 23 66 29 0a 3b 3b 3b 20 n1 rn2) #f).;;; 2160: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else ( 2170: 3c 20 28 69 74 65 6d 2d 70 6f 73 20 69 74 65 6d < (item-pos item 2180: 31 29 20 28 69 74 65 6d 2d 70 6f 73 20 69 74 65 1) (item-pos ite 2190: 6d 32 29 29 29 29 29 29 0a 0a 20 20 20 20 28 64 m2)))))).. (d 21a0: 65 66 69 6e 65 20 28 69 74 65 6d 3c 3f 20 69 74 efine (item<? it 21b0: 65 6d 31 20 69 74 65 6d 32 29 0a 20 20 20 20 20 em1 item2). 21c0: 20 28 6c 65 74 20 28 28 69 70 31 20 28 69 74 65 (let ((ip1 (ite 21d0: 6d 2d 70 6f 73 20 69 74 65 6d 31 29 29 0a 09 20 m-pos item1)).. 21e0: 20 20 20 28 69 70 32 20 28 69 74 65 6d 2d 70 6f (ip2 (item-po 21f0: 73 20 69 74 65 6d 32 29 29 29 0a 09 28 63 6f 6e s item2)))..(con 2200: 64 20 28 28 3e 20 69 70 31 20 69 70 32 29 20 23 d ((> ip1 ip2) # 2210: 74 29 0a 09 20 20 20 20 20 20 28 28 3c 20 69 70 t).. ((< ip 2220: 31 20 69 70 32 29 20 23 66 29 0a 09 20 20 20 20 1 ip2) #f).. 2230: 20 20 28 65 6c 73 65 20 28 3c 20 28 72 75 6c 65 (else (< (rule 2240: 2d 6e 6f 20 28 69 74 65 6d 2d 72 75 6c 65 20 69 -no (item-rule i 2250: 74 65 6d 31 29 29 0a 09 09 20 20 20 20 20 20 20 tem1))... 2260: 28 72 75 6c 65 2d 6e 6f 20 28 69 74 65 6d 2d 72 (rule-no (item-r 2270: 75 6c 65 20 69 74 65 6d 32 29 29 29 29 29 29 29 ule item2))))))) 2280: 0a 0a 3b 3b 3b 20 64 65 6c 65 74 65 64 20 62 65 ..;;; deleted be 2290: 63 61 75 73 65 20 73 74 61 74 65 73 20 6d 75 73 cause states mus 22a0: 74 20 2a 6e 6f 74 2a 20 73 68 61 72 65 20 69 74 t *not* share it 22b0: 65 6d 73 21 0a 3b 3b 3b 28 64 65 66 69 6e 65 20 ems!.;;;(define 22c0: 63 61 74 2d 3e 69 74 65 6d 73 0a 3b 3b 3b 20 20 cat->items.;;; 22d0: 28 6d 65 6d 6f 69 7a 65 31 20 63 61 74 40 0a 3b (memoize1 cat@.; 22e0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 6c ;; (l 22f0: 61 6d 62 64 61 20 28 63 61 74 29 0a 3b 3b 3b 20 ambda (cat).;;; 2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 (ma 2310: 70 20 28 6c 61 6d 62 64 61 20 28 72 75 6c 65 29 p (lambda (rule) 2320: 20 28 6d 61 6b 65 2d 69 74 65 6d 20 72 75 6c 65 (make-item rule 2330: 20 30 29 29 0a 3b 3b 3b 20 20 20 20 20 20 20 20 0)).;;; 2340: 20 20 20 20 20 20 20 20 20 20 20 28 65 78 70 61 (expa 2350: 6e 64 20 63 61 74 29 29 29 29 29 0a 20 0a 20 20 nd cat))))). . 2360: 20 20 28 64 65 66 69 6e 65 20 28 63 61 74 2d 3e (define (cat-> 2370: 69 74 65 6d 73 20 63 61 74 29 0a 20 20 20 20 20 items cat). 2380: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 (map (lambda (r 2390: 75 6c 65 29 20 28 6d 61 6b 65 2d 69 74 65 6d 20 ule) (make-item 23a0: 72 75 6c 65 20 30 29 29 0a 09 20 20 20 28 65 78 rule 0)).. (ex 23b0: 70 61 6e 64 20 63 61 74 29 29 29 0a 20 20 0a 20 pand cat))). . 23c0: 20 20 20 28 64 65 66 69 6e 65 20 28 63 6c 6f 73 (define (clos 23d0: 65 2d 69 74 65 6d 73 20 69 74 65 6d 73 29 0a 20 e-items items). 23e0: 20 20 20 20 20 28 63 6c 6f 73 65 20 28 6c 61 6d (close (lam 23f0: 62 64 61 20 28 69 74 65 6d 29 0a 09 20 20 20 20 bda (item).. 2400: 20 20 20 28 6c 65 74 20 28 28 72 68 2d 63 61 74 (let ((rh-cat 2410: 20 28 69 74 65 6d 2d 6e 65 78 74 20 69 74 65 6d (item-next item 2420: 29 29 29 0a 09 09 20 28 69 66 20 72 68 2d 63 61 )))... (if rh-ca 2430: 74 0a 09 09 20 20 20 20 20 28 63 61 74 2d 3e 69 t... (cat->i 2440: 74 65 6d 73 20 72 68 2d 63 61 74 29 0a 09 09 20 tems rh-cat)... 2450: 20 20 20 20 27 28 29 29 29 29 0a 09 20 20 20 20 '()))).. 2460: 20 69 74 65 6d 73 29 29 0a 20 20 0a 20 20 20 20 items)). . 2470: 28 64 65 66 69 6e 65 20 28 73 68 69 66 74 2d 69 (define (shift-i 2480: 74 65 6d 73 20 69 74 65 6d 73 20 63 61 74 29 0a tems items cat). 2490: 20 20 20 20 20 20 28 63 6f 6c 6c 65 63 74 20 28 (collect ( 24a0: 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 lambda (item)... 24b0: 20 28 69 66 20 28 65 71 3f 20 63 61 74 20 28 69 (if (eq? cat (i 24c0: 74 65 6d 2d 6e 65 78 74 20 69 74 65 6d 29 29 0a tem-next item)). 24d0: 09 09 20 20 20 20 20 28 6d 61 6b 65 2d 69 74 65 .. (make-ite 24e0: 6d 20 28 69 74 65 6d 2d 72 75 6c 65 20 69 74 65 m (item-rule ite 24f0: 6d 29 20 28 31 2b 20 28 69 74 65 6d 2d 70 6f 73 m) (1+ (item-pos 2500: 20 69 74 65 6d 29 29 29 0a 09 09 20 20 20 20 20 item)))... 2510: 23 66 29 29 0a 09 20 20 20 20 20 20 20 69 74 65 #f)).. ite 2520: 6d 73 29 29 0a 20 20 0a 3b 3b 3b 20 72 65 74 75 ms)). .;;; retu 2530: 72 6e 73 20 74 68 65 20 73 65 74 20 6f 66 20 63 rns the set of c 2540: 61 74 65 67 6f 72 69 65 73 20 61 70 70 65 61 72 ategories appear 2550: 69 6e 67 20 74 6f 20 74 68 65 20 72 69 67 68 74 ing to the right 2560: 20 6f 66 20 74 68 65 20 64 6f 74 0a 0a 20 20 20 of the dot.. 2570: 20 28 64 65 66 69 6e 65 20 28 69 74 65 6d 73 2d (define (items- 2580: 6e 65 78 74 20 69 74 65 6d 73 29 0a 20 20 20 20 next items). 2590: 20 20 28 63 6f 6c 6c 65 63 74 20 69 74 65 6d 2d (collect item- 25a0: 6e 65 78 74 20 69 74 65 6d 73 29 29 0a 20 20 0a next items)). . 25b0: 0a 3b 3b 3b 20 20 54 68 65 20 61 63 74 75 61 6c .;;; The actual 25c0: 20 74 61 62 6c 65 20 63 6f 6e 73 74 72 75 63 74 table construct 25d0: 69 6f 6e 20 66 75 6e 63 74 69 6f 6e 73 0a 0a 20 ion functions.. 25e0: 20 20 20 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 (define (make 25f0: 2d 73 74 61 74 65 20 6e 6f 20 69 74 65 6d 73 29 -state no items) 2600: 20 28 76 65 63 74 6f 72 20 6e 6f 20 69 74 65 6d (vector no item 2610: 73 20 23 66 29 29 0a 20 20 0a 20 20 20 20 28 64 s #f)). . (d 2620: 65 66 69 6e 65 20 28 73 74 61 74 65 2d 6e 6f 20 efine (state-no 2630: 73 74 61 74 65 29 20 28 76 65 63 74 6f 72 2d 72 state) (vector-r 2640: 65 66 20 73 74 61 74 65 20 30 29 29 0a 20 20 20 ef state 0)). 2650: 20 28 64 65 66 69 6e 65 20 28 73 74 61 74 65 2d (define (state- 2660: 69 74 65 6d 73 20 73 74 61 74 65 29 20 28 76 65 items state) (ve 2670: 63 74 6f 72 2d 72 65 66 20 73 74 61 74 65 20 31 ctor-ref state 1 2680: 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 28 )). (define ( 2690: 73 74 61 74 65 2d 73 68 69 66 74 73 20 73 74 61 state-shifts sta 26a0: 74 65 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 te) (vector-ref 26b0: 73 74 61 74 65 20 32 29 29 0a 20 20 20 20 28 64 state 2)). (d 26c0: 65 66 69 6e 65 20 28 73 74 61 74 65 2d 73 68 69 efine (state-shi 26d0: 66 74 73 2d 73 65 74 21 20 73 74 61 74 65 20 73 fts-set! state s 26e0: 68 69 66 74 73 29 20 28 76 65 63 74 6f 72 2d 73 hifts) (vector-s 26f0: 65 74 21 20 73 74 61 74 65 20 32 20 73 68 69 66 et! state 2 shif 2700: 74 73 29 29 0a 20 20 0a 0a 20 20 20 20 28 64 65 ts)). .. (de 2710: 66 69 6e 65 20 28 73 6f 72 74 2d 69 74 65 6d 73 fine (sort-items 2720: 21 20 69 74 65 6d 73 29 20 28 73 6f 72 74 21 20 ! items) (sort! 2730: 69 74 65 6d 3c 3f 20 69 74 65 6d 73 29 29 0a 0a item<? items)).. 2740: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 74 61 74 (let* ((stat 2750: 65 40 20 28 74 72 69 65 2d 6d 61 6b 65 72 20 28 e@ (trie-maker ( 2760: 61 76 6c 2d 6d 61 6b 65 72 20 69 74 65 6d 3c 3f avl-maker item<? 2770: 29 29 29 0a 09 20 20 20 28 69 6e 69 74 69 61 6c ))).. (initial 2780: 2d 69 74 65 6d 20 28 6d 61 6b 65 2d 69 74 65 6d -item (make-item 2790: 20 28 6d 61 6b 65 2d 72 75 6c 65 20 2d 31 20 6e (make-rule -1 n 27a0: 65 77 2d 73 74 61 72 74 2d 73 79 6d 62 6f 6c 0a ew-start-symbol. 27b0: 09 09 09 09 09 20 20 20 20 20 20 20 28 6c 69 73 ..... (lis 27c0: 74 20 73 74 61 72 74 2d 73 79 6d 62 6f 6c 29 20 t start-symbol) 27d0: 23 66 29 20 30 29 29 0a 0a 09 20 20 20 28 73 74 #f) 0))... (st 27e0: 61 74 65 2d 76 65 63 0a 09 20 20 20 20 28 6c 65 ate-vec.. (le 27f0: 74 20 28 28 61 73 73 63 20 28 28 73 74 61 74 65 t ((assc ((state 2800: 40 20 27 6d 61 6b 65 29 29 29 0a 09 09 20 20 28 @ 'make)))... ( 2810: 72 65 66 20 28 73 74 61 74 65 40 20 27 72 65 66 ref (state@ 'ref 2820: 29 29 0a 09 09 20 20 28 73 65 74 74 65 72 21 20 ))... (setter! 2830: 28 73 74 61 74 65 40 20 27 73 65 74 21 29 29 0a (state@ 'set!)). 2840: 09 09 20 20 28 6e 73 74 61 74 65 73 20 30 29 29 .. (nstates 0)) 2850: 0a 09 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 .. (define 2860: 28 66 6f 6c 6c 6f 77 20 69 74 65 6d 73 29 0a 09 (follow items).. 2870: 09 28 6c 65 74 2a 20 28 28 73 69 74 65 6d 73 20 .(let* ((sitems 2880: 28 73 6f 72 74 2d 69 74 65 6d 73 21 20 69 74 65 (sort-items! ite 2890: 6d 73 29 29 0a 09 09 20 20 20 20 20 20 20 28 65 ms))... (e 28a0: 78 69 73 74 69 6e 67 2d 73 74 61 74 65 20 28 72 xisting-state (r 28b0: 65 66 20 61 73 73 63 20 73 69 74 65 6d 73 29 29 ef assc sitems)) 28c0: 29 0a 09 09 20 20 28 69 66 20 65 78 69 73 74 69 )... (if existi 28d0: 6e 67 2d 73 74 61 74 65 0a 09 09 20 20 20 20 20 ng-state... 28e0: 20 28 73 74 61 74 65 2d 6e 6f 20 65 78 69 73 74 (state-no exist 28f0: 69 6e 67 2d 73 74 61 74 65 29 0a 09 09 20 20 20 ing-state)... 2900: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 6c 65 (begin....(le 2910: 74 2a 20 28 28 63 6c 6f 73 75 72 65 20 28 73 6f t* ((closure (so 2920: 72 74 2d 69 74 65 6d 73 21 20 28 63 6c 6f 73 65 rt-items! (close 2930: 2d 69 74 65 6d 73 20 73 69 74 65 6d 73 29 29 29 -items sitems))) 2940: 0a 09 09 09 20 20 20 20 20 20 20 28 73 74 61 74 .... (stat 2950: 65 20 28 6d 61 6b 65 2d 73 74 61 74 65 20 6e 73 e (make-state ns 2960: 74 61 74 65 73 20 63 6c 6f 73 75 72 65 29 29 29 tates closure))) 2970: 0a 09 09 09 20 20 28 73 65 74 21 20 6e 73 74 61 .... (set! nsta 2980: 74 65 73 20 28 31 2b 20 6e 73 74 61 74 65 73 29 tes (1+ nstates) 2990: 29 0a 09 09 09 20 20 28 73 65 74 74 65 72 21 20 ).... (setter! 29a0: 61 73 73 63 20 73 69 74 65 6d 73 20 73 74 61 74 assc sitems stat 29b0: 65 29 0a 09 09 09 20 20 28 73 74 61 74 65 2d 73 e).... (state-s 29c0: 68 69 66 74 73 2d 73 65 74 21 0a 09 09 09 20 20 hifts-set!.... 29d0: 20 73 74 61 74 65 0a 09 09 09 20 20 20 28 6d 61 state.... (ma 29e0: 70 20 28 6c 61 6d 62 64 61 20 28 63 61 74 29 0a p (lambda (cat). 29f0: 09 09 09 09 20 20 28 63 6f 6e 73 20 63 61 74 0a .... (cons cat. 2a00: 09 09 09 09 09 28 66 6f 6c 6c 6f 77 20 28 73 68 .....(follow (sh 2a10: 69 66 74 2d 69 74 65 6d 73 20 63 6c 6f 73 75 72 ift-items closur 2a20: 65 20 63 61 74 29 29 29 29 0a 09 09 09 09 28 63 e cat)))).....(c 2a30: 6f 6c 6c 65 63 74 20 69 74 65 6d 2d 6e 65 78 74 ollect item-next 2a40: 20 63 6c 6f 73 75 72 65 29 29 29 0a 09 09 09 20 closure))).... 2a50: 20 28 73 74 61 74 65 2d 6e 6f 20 73 74 61 74 65 (state-no state 2a60: 29 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 66 )))))).. (f 2a70: 6f 6c 6c 6f 77 20 28 6c 69 73 74 20 69 6e 69 74 ollow (list init 2a80: 69 61 6c 2d 69 74 65 6d 29 29 0a 09 20 20 20 20 ial-item)).. 2a90: 20 20 28 6c 65 74 20 28 28 73 74 61 74 65 2d 76 (let ((state-v 2aa0: 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ec (make-vector 2ab0: 6e 73 74 61 74 65 73 29 29 29 0a 09 09 28 28 73 nstates)))...((s 2ac0: 74 61 74 65 40 20 27 66 6f 72 2d 65 61 63 68 29 tate@ 'for-each) 2ad0: 20 61 73 73 63 0a 09 09 09 09 20 20 20 20 28 6c assc..... (l 2ae0: 61 6d 62 64 61 20 28 69 74 65 6d 73 20 73 74 61 ambda (items sta 2af0: 74 65 29 20 0a 09 09 09 09 20 20 20 20 20 20 28 te) ..... ( 2b00: 76 65 63 74 6f 72 2d 73 65 74 21 20 73 74 61 74 vector-set! stat 2b10: 65 2d 76 65 63 20 28 73 74 61 74 65 2d 6e 6f 20 e-vec (state-no 2b20: 73 74 61 74 65 29 0a 09 09 09 09 09 09 20 20 20 state)....... 2b30: 73 74 61 74 65 29 29 29 0a 09 09 73 74 61 74 65 state)))...state 2b40: 2d 76 65 63 29 29 29 29 0a 20 20 20 20 20 20 20 -vec)))). 2b50: 20 20 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 . (define 2b60: 20 28 70 72 6f 70 61 67 61 74 65 2d 6c 61 20 73 (propagate-la s 2b70: 74 61 74 65 2d 6e 6f 20 72 75 6c 65 20 70 6f 73 tate-no rule pos 2b80: 20 6c 61 29 0a 09 28 6c 65 74 2a 20 28 28 73 74 la)..(let* ((st 2b90: 61 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ate (vector-ref 2ba0: 73 74 61 74 65 2d 76 65 63 20 73 74 61 74 65 2d state-vec state- 2bb0: 6e 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 no)).. (st 2bc0: 61 74 65 2d 69 74 65 6d 20 28 66 69 6e 64 2d 69 ate-item (find-i 2bd0: 66 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 f (lambda (item) 2be0: 20 0a 09 09 09 09 20 20 20 20 20 20 28 61 6e 64 ..... (and 2bf0: 20 28 3d 20 28 72 75 6c 65 2d 6e 6f 20 72 75 6c (= (rule-no rul 2c00: 65 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 72 e)...... (r 2c10: 75 6c 65 2d 6e 6f 20 28 69 74 65 6d 2d 72 75 6c ule-no (item-rul 2c20: 65 20 69 74 65 6d 29 29 29 0a 09 09 09 09 09 20 e item)))...... 2c30: 20 20 28 3d 20 70 6f 73 20 28 69 74 65 6d 2d 70 (= pos (item-p 2c40: 6f 73 20 69 74 65 6d 29 29 29 29 0a 09 09 09 09 os item))))..... 2c50: 20 20 20 20 28 73 74 61 74 65 2d 69 74 65 6d 73 (state-items 2c60: 20 73 74 61 74 65 29 29 29 29 0a 09 20 20 28 63 state)))).. (c 2c70: 6f 6e 64 20 28 28 6e 6f 74 20 28 6d 65 6d 62 65 ond ((not (membe 2c80: 72 20 6c 61 20 28 69 74 65 6d 2d 6c 61 73 20 73 r la (item-las s 2c90: 74 61 74 65 2d 69 74 65 6d 29 29 29 0a 09 09 20 tate-item)))... 2ca0: 28 69 74 65 6d 2d 6c 61 73 2d 70 75 73 68 21 20 (item-las-push! 2cb0: 73 74 61 74 65 2d 69 74 65 6d 20 6c 61 29 0a 09 state-item la).. 2cc0: 09 20 28 6c 65 74 20 28 28 72 68 73 20 28 6c 69 . (let ((rhs (li 2cd0: 73 74 2d 73 75 66 66 69 78 20 28 72 75 6c 65 2d st-suffix (rule- 2ce0: 64 61 75 67 68 74 65 72 73 20 72 75 6c 65 29 20 daughters rule) 2cf0: 70 6f 73 29 29 29 0a 09 09 20 20 20 28 69 66 20 pos)))... (if 2d00: 28 70 61 69 72 3f 20 72 68 73 29 0a 09 09 20 20 (pair? rhs)... 2d10: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d (let ((new- 2d20: 6c 61 73 20 28 6c 65 66 74 2d 6d 6f 73 74 20 28 las (left-most ( 2d30: 61 70 70 65 6e 64 20 28 63 64 72 20 72 68 73 29 append (cdr rhs) 2d40: 20 28 6c 69 73 74 20 6c 61 29 29 29 29 29 0a 09 (list la))))).. 2d50: 09 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 .. (for-each (la 2d60: 6d 62 64 61 20 28 6e 65 77 2d 72 75 6c 65 29 0a mbda (new-rule). 2d70: 09 09 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 .... (for-ea 2d80: 63 68 20 28 6c 61 6d 62 64 61 20 28 6e 65 77 2d ch (lambda (new- 2d90: 6c 61 29 20 0a 09 09 09 09 09 09 20 28 70 72 6f la) ....... (pro 2da0: 70 61 67 61 74 65 2d 6c 61 20 73 74 61 74 65 2d pagate-la state- 2db0: 6e 6f 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 no........ 2dc0: 20 6e 65 77 2d 72 75 6c 65 20 30 0a 09 09 09 09 new-rule 0..... 2dd0: 09 09 09 20 20 20 20 20 20 20 6e 65 77 2d 6c 61 ... new-la 2de0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 6e ))...... n 2df0: 65 77 2d 6c 61 73 29 29 0a 09 09 09 09 20 20 20 ew-las))..... 2e00: 28 65 78 70 61 6e 64 20 28 63 61 72 20 72 68 73 (expand (car rhs 2e10: 29 29 29 0a 09 09 09 20 28 70 72 6f 70 61 67 61 ))).... (propaga 2e20: 74 65 2d 6c 61 20 28 63 64 72 20 28 61 73 73 71 te-la (cdr (assq 2e30: 20 28 63 61 72 20 72 68 73 29 20 28 73 74 61 74 (car rhs) (stat 2e40: 65 2d 73 68 69 66 74 73 20 73 74 61 74 65 29 29 e-shifts state)) 2e50: 29 0a 09 09 09 09 20 20 20 20 20 20 20 72 75 6c )..... rul 2e60: 65 20 28 31 2b 20 70 6f 73 29 20 6c 61 29 29 29 e (1+ pos) la))) 2e70: 29 29 29 29 29 0a 0a 20 20 20 20 20 20 28 64 65 ))))).. (de 2e80: 66 69 6e 65 20 28 70 72 69 6e 74 2d 74 61 62 6c fine (print-tabl 2e90: 65 29 0a 09 28 64 65 66 69 6e 65 20 28 73 70 61 e)..(define (spa 2ea0: 63 65 2d 64 69 73 70 6c 61 79 20 70 29 20 28 64 ce-display p) (d 2eb0: 69 73 70 6c 61 79 20 22 20 22 29 20 28 64 69 73 isplay " ") (dis 2ec0: 70 6c 61 79 20 70 29 29 0a 09 28 64 6f 20 28 28 play p))..(do (( 2ed0: 73 74 61 74 65 2d 6e 6f 20 30 20 28 31 2b 20 73 state-no 0 (1+ s 2ee0: 74 61 74 65 2d 6e 6f 29 29 29 0a 09 20 20 20 20 tate-no))).. 2ef0: 28 28 3d 20 73 74 61 74 65 2d 6e 6f 20 28 76 65 ((= state-no (ve 2f00: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 74 61 74 ctor-length stat 2f10: 65 2d 76 65 63 29 29 29 0a 09 20 20 28 6e 65 77 e-vec))).. (new 2f20: 6c 69 6e 65 29 20 28 64 69 73 70 6c 61 79 20 22 line) (display " 2f30: 53 74 61 74 65 20 22 29 20 28 64 69 73 70 6c 61 State ") (displa 2f40: 79 20 73 74 61 74 65 2d 6e 6f 29 20 28 6e 65 77 y state-no) (new 2f50: 6c 69 6e 65 29 0a 09 20 20 28 6c 65 74 2a 20 28 line).. (let* ( 2f60: 28 73 74 61 74 65 20 28 76 65 63 74 6f 72 2d 72 (state (vector-r 2f70: 65 66 20 73 74 61 74 65 2d 76 65 63 20 73 74 61 ef state-vec sta 2f80: 74 65 2d 6e 6f 29 29 0a 09 09 20 28 64 65 6a 61 te-no))... (deja 2f90: 2d 76 75 20 28 6d 61 70 20 63 61 72 20 28 73 74 -vu (map car (st 2fa0: 61 74 65 2d 73 68 69 66 74 73 20 73 74 61 74 65 ate-shifts state 2fb0: 29 29 29 0a 09 09 20 28 63 6f 6e 66 6c 69 63 74 )))... (conflict 2fc0: 73 20 27 28 29 29 29 0a 09 20 20 20 20 28 66 6f s '())).. (fo 2fd0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda ( 2fe0: 69 74 65 6d 29 0a 09 09 09 28 6e 65 77 6c 69 6e item)....(newlin 2ff0: 65 29 20 0a 09 09 09 28 64 69 73 70 6c 61 79 20 e) ....(display 3000: 22 20 20 20 20 20 22 29 20 0a 09 09 09 28 64 69 " ") ....(di 3010: 73 70 6c 61 79 20 28 72 75 6c 65 2d 6d 6f 74 68 splay (rule-moth 3020: 65 72 20 28 69 74 65 6d 2d 72 75 6c 65 20 69 74 er (item-rule it 3030: 65 6d 29 29 29 0a 09 09 09 28 64 69 73 70 6c 61 em)))....(displa 3040: 79 20 22 20 2d 2d 3e 22 29 0a 09 09 09 28 66 6f y " -->")....(fo 3050: 72 2d 65 61 63 68 20 73 70 61 63 65 2d 64 69 73 r-each space-dis 3060: 70 6c 61 79 20 0a 09 09 09 09 20 20 28 73 75 62 play ..... (sub 3070: 6c 69 73 74 20 28 72 75 6c 65 2d 64 61 75 67 68 list (rule-daugh 3080: 74 65 72 73 20 28 69 74 65 6d 2d 72 75 6c 65 20 ters (item-rule 3090: 69 74 65 6d 29 29 0a 09 09 09 09 09 20 20 20 30 item))...... 0 30a0: 20 28 69 74 65 6d 2d 70 6f 73 20 69 74 65 6d 29 (item-pos item) 30b0: 29 29 0a 09 09 09 28 73 70 61 63 65 2d 64 69 73 ))....(space-dis 30c0: 70 6c 61 79 20 22 2e 22 29 0a 09 09 09 28 66 6f play ".")....(fo 30d0: 72 2d 65 61 63 68 20 73 70 61 63 65 2d 64 69 73 r-each space-dis 30e0: 70 6c 61 79 20 28 69 74 65 6d 2d 72 69 67 68 74 play (item-right 30f0: 20 69 74 65 6d 29 29 0a 09 09 09 28 73 70 61 63 item))....(spac 3100: 65 2d 64 69 73 70 6c 61 79 20 22 3b 22 29 0a 09 e-display ";").. 3110: 09 09 28 66 6f 72 2d 65 61 63 68 20 73 70 61 63 ..(for-each spac 3120: 65 2d 64 69 73 70 6c 61 79 20 28 69 74 65 6d 2d e-display (item- 3130: 6c 61 73 20 69 74 65 6d 29 29 29 0a 09 09 20 20 las item)))... 3140: 20 20 20 20 28 73 74 61 74 65 2d 69 74 65 6d 73 (state-items 3150: 20 73 74 61 74 65 29 29 0a 09 20 20 20 20 28 6e state)).. (n 3160: 65 77 6c 69 6e 65 29 0a 09 20 20 20 20 28 66 6f ewline).. (fo 3170: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda ( 3180: 73 68 69 66 74 29 0a 09 09 09 28 6e 65 77 6c 69 shift)....(newli 3190: 6e 65 29 0a 09 09 09 28 64 69 73 70 6c 61 79 20 ne)....(display 31a0: 22 20 20 4f 6e 20 22 29 0a 09 09 09 28 64 69 73 " On ")....(dis 31b0: 70 6c 61 79 20 28 63 61 72 20 73 68 69 66 74 29 play (car shift) 31c0: 29 0a 09 09 09 28 64 69 73 70 6c 61 79 20 22 20 )....(display " 31d0: 73 68 69 66 74 20 74 6f 20 73 74 61 74 65 20 22 shift to state " 31e0: 29 0a 09 09 09 28 64 69 73 70 6c 61 79 20 28 63 )....(display (c 31f0: 64 72 20 73 68 69 66 74 29 29 29 0a 09 09 20 20 dr shift)))... 3200: 20 20 20 20 28 73 74 61 74 65 2d 73 68 69 66 74 (state-shift 3210: 73 20 73 74 61 74 65 29 29 0a 09 20 20 20 20 28 s state)).. ( 3220: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda 3230: 20 28 69 74 65 6d 29 0a 09 09 09 28 6e 65 77 6c (item)....(newl 3240: 69 6e 65 29 0a 09 09 09 28 64 69 73 70 6c 61 79 ine)....(display 3250: 20 22 20 20 4f 6e 22 29 0a 09 09 09 28 66 6f 72 " On")....(for 3260: 2d 65 61 63 68 20 73 70 61 63 65 2d 64 69 73 70 -each space-disp 3270: 6c 61 79 20 28 69 74 65 6d 2d 6c 61 73 20 69 74 lay (item-las it 3280: 65 6d 29 29 0a 09 09 09 28 64 69 73 70 6c 61 79 em))....(display 3290: 20 22 20 72 65 64 75 63 65 3a 20 22 29 0a 09 09 " reduce: ")... 32a0: 09 28 64 69 73 70 6c 61 79 20 28 72 75 6c 65 2d .(display (rule- 32b0: 6d 6f 74 68 65 72 20 28 69 74 65 6d 2d 72 75 6c mother (item-rul 32c0: 65 20 69 74 65 6d 29 29 29 0a 09 09 09 28 64 69 e item)))....(di 32d0: 73 70 6c 61 79 20 22 20 2d 2d 3e 22 29 0a 09 09 splay " -->")... 32e0: 09 28 66 6f 72 2d 65 61 63 68 20 73 70 61 63 65 .(for-each space 32f0: 2d 64 69 73 70 6c 61 79 20 28 72 75 6c 65 2d 64 -display (rule-d 3300: 61 75 67 68 74 65 72 73 20 28 69 74 65 6d 2d 72 aughters (item-r 3310: 75 6c 65 20 69 74 65 6d 29 29 29 0a 09 09 09 28 ule item)))....( 3320: 6c 65 74 20 28 28 63 73 20 28 69 6e 74 65 72 73 let ((cs (inters 3330: 65 63 74 69 6f 6e 20 28 69 74 65 6d 2d 6c 61 73 ection (item-las 3340: 20 69 74 65 6d 29 20 64 65 6a 61 2d 76 75 29 29 item) deja-vu)) 3350: 29 0a 09 09 09 20 20 28 69 66 20 28 6e 6f 74 20 ).... (if (not 3360: 28 6e 75 6c 6c 3f 20 63 73 29 29 0a 09 09 09 20 (null? cs)).... 3370: 20 20 20 20 20 28 73 65 74 21 20 63 6f 6e 66 6c (set! confl 3380: 69 63 74 73 20 28 75 6e 69 6f 6e 20 63 73 20 63 icts (union cs c 3390: 6f 6e 66 6c 69 63 74 73 29 29 29 29 29 0a 09 09 onflicts)))))... 33a0: 20 20 20 20 20 20 28 73 65 6c 65 63 74 20 28 6c (select (l 33b0: 61 6d 62 64 61 20 28 69 74 65 6d 29 20 28 6e 75 ambda (item) (nu 33c0: 6c 6c 3f 20 28 69 74 65 6d 2d 72 69 67 68 74 20 ll? (item-right 33d0: 69 74 65 6d 29 29 29 0a 09 09 09 20 20 20 20 20 item))).... 33e0: 20 28 73 74 61 74 65 2d 69 74 65 6d 73 20 73 74 (state-items st 33f0: 61 74 65 29 29 29 0a 09 20 20 20 20 28 69 66 20 ate))).. (if 3400: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 63 6f 6e 66 (not (null? conf 3410: 6c 69 63 74 73 29 29 0a 09 09 28 62 65 67 69 6e licts))...(begin 3420: 0a 09 09 20 20 28 6e 65 77 6c 69 6e 65 29 0a 09 ... (newline).. 3430: 09 20 20 28 64 69 73 70 6c 61 79 20 22 20 20 2a . (display " * 3440: 2a 20 43 6f 6e 66 6c 69 63 74 69 6e 67 20 61 63 * Conflicting ac 3450: 74 69 6f 6e 73 20 6f 6e 22 29 0a 09 09 20 20 28 tions on")... ( 3460: 66 6f 72 2d 65 61 63 68 20 73 70 61 63 65 2d 64 for-each space-d 3470: 69 73 70 6c 61 79 20 63 6f 6e 66 6c 69 63 74 73 isplay conflicts 3480: 29 29 29 0a 09 20 20 20 20 28 6e 65 77 6c 69 6e ))).. (newlin 3490: 65 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 20 e)))). . 34a0: 20 28 70 72 6f 70 61 67 61 74 65 2d 6c 61 20 30 (propagate-la 0 34b0: 20 28 69 74 65 6d 2d 72 75 6c 65 20 69 6e 69 74 (item-rule init 34c0: 69 61 6c 2d 69 74 65 6d 29 20 30 20 20 65 6e 64 ial-item) 0 end 34d0: 2d 6d 61 72 6b 65 72 29 0a 20 20 20 20 0a 20 20 -marker). . 34e0: 20 20 20 20 28 69 66 20 70 72 69 6e 74 2d 66 6c (if print-fl 34f0: 61 67 0a 09 20 20 28 70 72 69 6e 74 2d 74 61 62 ag.. (print-tab 3500: 6c 65 29 29 0a 0a 20 20 20 20 20 20 28 6c 65 74 le)).. (let 3510: 20 28 28 73 68 69 66 74 2d 76 65 63 20 28 6d 61 ((shift-vec (ma 3520: 6b 65 2d 76 65 63 74 6f 72 20 28 76 65 63 74 6f ke-vector (vecto 3530: 72 2d 6c 65 6e 67 74 68 20 73 74 61 74 65 2d 76 r-length state-v 3540: 65 63 29 29 29 0a 09 20 20 20 20 28 67 6f 74 6f ec))).. (goto 3550: 2d 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f -vec (make-vecto 3560: 72 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 r (vector-length 3570: 20 73 74 61 74 65 2d 76 65 63 29 29 29 0a 09 20 state-vec))).. 3580: 20 20 20 28 72 65 64 6e 2d 76 65 63 20 28 6d 61 (redn-vec (ma 3590: 6b 65 2d 76 65 63 74 6f 72 20 28 76 65 63 74 6f ke-vector (vecto 35a0: 72 2d 6c 65 6e 67 74 68 20 73 74 61 74 65 2d 76 r-length state-v 35b0: 65 63 29 29 29 0a 09 20 20 20 20 28 72 75 6c 65 ec))).. (rule 35c0: 2d 70 61 72 65 6e 74 2d 76 65 63 20 28 6d 61 6b -parent-vec (mak 35d0: 65 2d 76 65 63 74 6f 72 20 6e 72 75 6c 65 73 29 e-vector nrules) 35e0: 29 0a 09 20 20 20 20 28 72 75 6c 65 2d 6c 65 6e ).. (rule-len 35f0: 67 74 68 2d 76 65 63 20 28 6d 61 6b 65 2d 76 65 gth-vec (make-ve 3600: 63 74 6f 72 20 6e 72 75 6c 65 73 29 29 0a 09 20 ctor nrules)).. 3610: 20 20 20 28 72 75 6c 65 2d 61 63 74 69 6f 6e 2d (rule-action- 3620: 76 65 63 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 vec (make-vector 3630: 20 6e 72 75 6c 65 73 29 29 29 0a 09 28 64 6f 20 nrules)))..(do 3640: 28 28 69 20 30 20 28 2b 20 69 20 31 29 29 29 0a ((i 0 (+ i 1))). 3650: 09 20 20 20 20 28 28 3d 20 69 20 28 76 65 63 74 . ((= i (vect 3660: 6f 72 2d 6c 65 6e 67 74 68 20 73 74 61 74 65 2d or-length state- 3670: 76 65 63 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 vec))).. (let* 3680: 28 28 73 74 61 74 65 20 28 76 65 63 74 6f 72 2d ((state (vector- 3690: 72 65 66 20 73 74 61 74 65 2d 76 65 63 20 69 29 ref state-vec i) 36a0: 29 0a 09 09 20 28 73 6f 2d 66 61 72 20 28 6d 61 )... (so-far (ma 36b0: 70 20 63 61 72 20 28 73 74 61 74 65 2d 73 68 69 p car (state-shi 36c0: 66 74 73 20 73 74 61 74 65 29 29 29 29 0a 09 20 fts state)))).. 36d0: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set! 36e0: 73 68 69 66 74 2d 76 65 63 20 69 0a 09 09 09 20 shift-vec i.... 36f0: 28 73 65 6c 65 63 74 20 28 6c 61 6d 62 64 61 20 (select (lambda 3700: 28 73 68 69 66 74 29 0a 09 09 09 09 20 20 20 28 (shift)..... ( 3710: 6d 65 6d 62 65 72 20 28 63 61 72 20 73 68 69 66 member (car shif 3720: 74 29 20 74 65 72 6d 69 6e 61 6c 73 29 29 0a 09 t) terminals)).. 3730: 09 09 09 20 28 73 74 61 74 65 2d 73 68 69 66 74 ... (state-shift 3740: 73 20 73 74 61 74 65 29 29 29 0a 09 20 20 20 20 s state))).. 3750: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 67 6f 74 (vector-set! got 3760: 6f 2d 76 65 63 20 69 0a 09 09 09 20 28 73 65 6c o-vec i.... (sel 3770: 65 63 74 20 28 6c 61 6d 62 64 61 20 28 73 68 69 ect (lambda (shi 3780: 66 74 29 0a 09 09 09 09 20 20 20 28 6d 65 6d 62 ft)..... (memb 3790: 65 72 20 28 63 61 72 20 73 68 69 66 74 29 20 6e er (car shift) n 37a0: 6f 6e 74 65 72 6d 69 6e 61 6c 73 29 29 0a 09 09 onterminals))... 37b0: 09 09 20 28 73 74 61 74 65 2d 73 68 69 66 74 73 .. (state-shifts 37c0: 20 73 74 61 74 65 29 29 29 0a 09 20 20 20 20 28 state))).. ( 37d0: 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 64 6e vector-set! redn 37e0: 2d 76 65 63 20 69 0a 09 09 09 20 28 6d 61 70 20 -vec i.... (map 37f0: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item).. 3800: 09 09 09 28 6c 65 74 20 28 28 6e 65 77 2d 6c 61 ...(let ((new-la 3810: 73 20 28 73 75 62 74 72 61 63 74 20 28 69 74 65 s (subtract (ite 3820: 6d 2d 6c 61 73 20 69 74 65 6d 29 20 73 6f 2d 66 m-las item) so-f 3830: 61 72 29 29 29 0a 09 09 09 09 20 20 28 73 65 74 ar)))..... (set 3840: 21 20 73 6f 2d 66 61 72 20 28 61 70 70 65 6e 64 ! so-far (append 3850: 20 6e 65 77 2d 6c 61 73 20 73 6f 2d 66 61 72 29 new-las so-far) 3860: 29 0a 09 09 09 09 20 20 28 63 6f 6e 73 20 28 72 )..... (cons (r 3870: 75 6c 65 2d 6e 6f 20 28 69 74 65 6d 2d 72 75 6c ule-no (item-rul 3880: 65 20 69 74 65 6d 29 29 20 6e 65 77 2d 6c 61 73 e item)) new-las 3890: 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 73 65 ))).... (se 38a0: 6c 65 63 74 20 28 6c 61 6d 62 64 61 20 28 69 74 lect (lambda (it 38b0: 65 6d 29 20 28 6e 75 6c 6c 3f 20 28 69 74 65 6d em) (null? (item 38c0: 2d 72 69 67 68 74 20 69 74 65 6d 29 29 29 0a 09 -right item))).. 38d0: 09 09 09 20 20 20 20 20 20 28 73 74 61 74 65 2d ... (state- 38e0: 69 74 65 6d 73 20 73 74 61 74 65 29 29 29 29 29 items state))))) 38f0: 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 )..(for-each (la 3900: 6d 62 64 61 20 28 72 75 6c 65 29 0a 09 09 20 20 mbda (rule)... 3910: 20 20 28 6c 65 74 20 28 28 6e 6f 20 28 72 75 6c (let ((no (rul 3920: 65 2d 6e 6f 20 72 75 6c 65 29 29 29 0a 09 09 20 e-no rule)))... 3930: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set 3940: 21 20 72 75 6c 65 2d 70 61 72 65 6e 74 2d 76 65 ! rule-parent-ve 3950: 63 20 6e 6f 20 28 72 75 6c 65 2d 6d 6f 74 68 65 c no (rule-mothe 3960: 72 20 72 75 6c 65 29 29 0a 09 09 20 20 20 20 20 r rule))... 3970: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 75 (vector-set! ru 3980: 6c 65 2d 6c 65 6e 67 74 68 2d 76 65 63 20 6e 6f le-length-vec no 3990: 0a 09 09 09 09 20 20 20 28 6c 65 6e 67 74 68 20 ..... (length 39a0: 28 72 75 6c 65 2d 64 61 75 67 68 74 65 72 73 20 (rule-daughters 39b0: 72 75 6c 65 29 29 29 0a 09 09 20 20 20 20 20 20 rule)))... 39c0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 75 6c (vector-set! rul 39d0: 65 2d 61 63 74 69 6f 6e 2d 76 65 63 20 6e 6f 20 e-action-vec no 39e0: 28 72 75 6c 65 2d 61 63 74 69 6f 6e 20 72 75 6c (rule-action rul 39f0: 65 29 29 29 29 0a 09 09 20 20 67 72 75 6c 65 73 e))))... grules 3a00: 29 0a 09 0a 09 28 76 65 63 74 6f 72 20 73 68 69 )....(vector shi 3a10: 66 74 2d 76 65 63 0a 09 09 67 6f 74 6f 2d 76 65 ft-vec...goto-ve 3a20: 63 0a 09 09 72 65 64 6e 2d 76 65 63 0a 09 09 72 c...redn-vec...r 3a30: 75 6c 65 2d 70 61 72 65 6e 74 2d 76 65 63 0a 09 ule-parent-vec.. 3a40: 09 72 75 6c 65 2d 6c 65 6e 67 74 68 2d 76 65 63 .rule-length-vec 3a50: 0a 09 09 72 75 6c 65 2d 61 63 74 69 6f 6e 2d 76 ...rule-action-v 3a60: 65 63 29 0a 09 29 29 29 29 0a 20 20 0a 28 64 65 ec)..)))). .(de 3a70: 66 69 6e 65 20 28 6c 61 6c 72 2d 70 61 72 73 65 fine (lalr-parse 3a80: 72 20 6c 61 6c 72 2d 74 61 62 6c 65 73 20 6c 65 r lalr-tables le 3a90: 78 69 63 61 6c 2d 61 6e 61 6c 79 73 65 72 20 70 xical-analyser p 3aa0: 61 72 73 65 2d 65 72 72 6f 72 29 0a 20 20 28 64 arse-error). (d 3ab0: 65 66 69 6e 65 20 65 6e 64 2d 6d 61 72 6b 65 72 efine end-marker 3ac0: 20 27 24 65 6e 64 24 29 0a 20 20 28 64 65 66 69 '$end$). (defi 3ad0: 6e 65 20 28 66 69 6e 64 2d 72 65 64 6e 20 6c 61 ne (find-redn la 3ae0: 20 72 65 64 6e 73 29 0a 20 20 20 20 28 69 66 20 redns). (if 3af0: 28 6e 75 6c 6c 3f 20 72 65 64 6e 73 29 0a 20 20 (null? redns). 3b00: 20 20 20 20 23 66 0a 20 20 20 20 20 20 28 69 66 #f. (if 3b10: 20 28 6d 65 6d 71 20 6c 61 20 28 63 64 61 72 20 (memq la (cdar 3b20: 72 65 64 6e 73 29 29 0a 20 20 20 20 20 20 20 20 redns)). 3b30: 28 63 61 61 72 20 72 65 64 6e 73 29 0a 20 20 20 (caar redns). 3b40: 20 20 20 20 20 28 66 69 6e 64 2d 72 65 64 6e 20 (find-redn 3b50: 6c 61 20 28 63 64 72 20 72 65 64 6e 73 29 29 29 la (cdr redns))) 3b60: 29 29 0a 20 20 28 64 65 66 69 6e 65 20 28 6c 69 )). (define (li 3b70: 73 74 2d 70 72 65 66 69 78 20 65 6c 74 73 20 6e st-prefix elts n 3b80: 29 0a 20 20 20 20 28 69 66 20 28 7a 65 72 6f 3f ). (if (zero? 3b90: 20 6e 29 20 27 28 29 20 28 63 6f 6e 73 20 28 63 n) '() (cons (c 3ba0: 61 72 20 65 6c 74 73 29 20 28 6c 69 73 74 2d 70 ar elts) (list-p 3bb0: 72 65 66 69 78 20 28 63 64 72 20 65 6c 74 73 29 refix (cdr elts) 3bc0: 20 28 2d 20 6e 20 31 29 29 29 29 29 20 20 0a 20 (- n 1))))) . 3bd0: 20 28 64 65 66 69 6e 65 20 28 6c 69 73 74 2d 73 (define (list-s 3be0: 75 66 66 69 78 20 65 6c 74 73 20 6e 29 0a 20 20 uffix elts n). 3bf0: 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 6e 29 20 (if (zero? n) 3c00: 65 6c 74 73 20 28 6c 69 73 74 2d 73 75 66 66 69 elts (list-suffi 3c10: 78 20 28 63 64 72 20 65 6c 74 73 29 20 28 2d 20 x (cdr elts) (- 3c20: 6e 20 31 29 29 29 29 20 20 0a 20 20 28 6c 65 74 n 1)))) . (let 3c30: 20 28 28 73 68 69 66 74 2d 76 65 63 20 28 76 65 ((shift-vec (ve 3c40: 63 74 6f 72 2d 72 65 66 20 6c 61 6c 72 2d 74 61 ctor-ref lalr-ta 3c50: 62 6c 65 73 20 30 29 29 0a 20 20 20 20 20 20 20 bles 0)). 3c60: 20 28 67 6f 74 6f 2d 76 65 63 20 28 76 65 63 74 (goto-vec (vect 3c70: 6f 72 2d 72 65 66 20 6c 61 6c 72 2d 74 61 62 6c or-ref lalr-tabl 3c80: 65 73 20 31 29 29 0a 20 20 20 20 20 20 20 20 28 es 1)). ( 3c90: 72 65 64 6e 2d 76 65 63 20 28 76 65 63 74 6f 72 redn-vec (vector 3ca0: 2d 72 65 66 20 6c 61 6c 72 2d 74 61 62 6c 65 73 -ref lalr-tables 3cb0: 20 32 29 29 0a 20 20 20 20 20 20 20 20 28 72 75 2)). (ru 3cc0: 6c 65 2d 70 61 72 65 6e 74 20 28 76 65 63 74 6f le-parent (vecto 3cd0: 72 2d 72 65 66 20 6c 61 6c 72 2d 74 61 62 6c 65 r-ref lalr-table 3ce0: 73 20 33 29 29 0a 20 20 20 20 20 20 20 20 28 72 s 3)). (r 3cf0: 75 6c 65 2d 6c 65 6e 67 74 68 20 28 76 65 63 74 ule-length (vect 3d00: 6f 72 2d 72 65 66 20 6c 61 6c 72 2d 74 61 62 6c or-ref lalr-tabl 3d10: 65 73 20 34 29 29 0a 20 20 20 20 20 20 20 20 28 es 4)). ( 3d20: 72 75 6c 65 2d 61 63 74 69 6f 6e 20 28 76 65 63 rule-action (vec 3d30: 74 6f 72 2d 72 65 66 20 6c 61 6c 72 2d 74 61 62 tor-ref lalr-tab 3d40: 6c 65 73 20 35 29 29 0a 20 20 20 20 20 20 20 20 les 5)). 3d50: 28 6e 65 78 74 2d 63 61 74 20 23 66 29 0a 20 20 (next-cat #f). 3d60: 20 20 20 20 20 20 28 6e 65 78 74 2d 76 61 6c 20 (next-val 3d70: 23 66 29 29 0a 20 20 20 20 28 64 65 66 69 6e 65 #f)). (define 3d80: 20 28 61 64 76 61 6e 63 65 2d 69 6e 70 75 74 29 (advance-input) 3d90: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 20 . (let ((p 3da0: 28 6c 65 78 69 63 61 6c 2d 61 6e 61 6c 79 73 65 (lexical-analyse 3db0: 72 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 r))). (if 3dc0: 20 28 70 61 69 72 3f 20 70 29 0a 20 20 20 20 20 (pair? p). 3dd0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin. 3de0: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 6e 65 (set! ne 3df0: 78 74 2d 63 61 74 20 28 63 61 72 20 70 29 29 0a xt-cat (car p)). 3e00: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set 3e10: 21 20 6e 65 78 74 2d 76 61 6c 20 28 63 64 72 20 ! next-val (cdr 3e20: 70 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 p))). ( 3e30: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin. 3e40: 20 20 28 73 65 74 21 20 6e 65 78 74 2d 63 61 74 (set! next-cat 3e50: 20 65 6e 64 2d 6d 61 72 6b 65 72 29 0a 20 20 20 end-marker). 3e60: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 6e (set! n 3e70: 65 78 74 2d 76 61 6c 20 23 66 29 29 29 29 29 0a ext-val #f))))). 3e80: 20 20 20 20 28 64 65 66 69 6e 65 20 28 6d 6f 76 (define (mov 3e90: 65 2a 20 73 74 61 74 65 20 73 74 61 74 65 73 20 e* state states 3ea0: 76 61 6c 73 29 0a 20 20 20 20 20 20 28 6c 65 74 vals). (let 3eb0: 2a 20 28 28 73 68 69 66 74 2d 70 61 69 72 20 28 * ((shift-pair ( 3ec0: 61 73 73 71 20 6e 65 78 74 2d 63 61 74 20 28 76 assq next-cat (v 3ed0: 65 63 74 6f 72 2d 72 65 66 20 73 68 69 66 74 2d ector-ref shift- 3ee0: 76 65 63 20 73 74 61 74 65 29 29 29 29 0a 20 20 vec state)))). 3ef0: 20 20 20 20 20 20 28 69 66 20 73 68 69 66 74 2d (if shift- 3f00: 70 61 69 72 20 0a 20 20 20 20 20 20 20 20 20 20 pair . 3f10: 28 6c 65 74 20 28 28 6f 6c 64 2d 76 61 6c 20 6e (let ((old-val n 3f20: 65 78 74 2d 76 61 6c 29 29 0a 20 20 20 20 20 20 ext-val)). 3f30: 20 20 20 20 20 20 28 61 64 76 61 6e 63 65 2d 69 (advance-i 3f40: 6e 70 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 nput). 3f50: 20 20 28 6d 6f 76 65 2a 20 28 63 64 72 20 73 68 (move* (cdr sh 3f60: 69 66 74 2d 70 61 69 72 29 0a 20 20 20 20 20 20 ift-pair). 3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co 3f80: 6e 73 20 73 74 61 74 65 20 73 74 61 74 65 73 29 ns state states) 3f90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3fa0: 20 20 20 20 28 63 6f 6e 73 20 6f 6c 64 2d 76 61 (cons old-va 3fb0: 6c 20 76 61 6c 73 29 29 29 0a 20 20 20 20 20 20 l vals))). 3fc0: 20 20 20 20 28 6c 65 74 20 28 28 72 65 64 6e 20 (let ((redn 3fd0: 28 66 69 6e 64 2d 72 65 64 6e 20 6e 65 78 74 2d (find-redn next- 3fe0: 63 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 cat (vector-ref 3ff0: 72 65 64 6e 2d 76 65 63 20 73 74 61 74 65 29 29 redn-vec state)) 4000: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). ( 4010: 69 66 20 72 65 64 6e 0a 20 20 20 20 20 20 20 20 if redn. 4020: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and ( 4030: 3d 20 72 65 64 6e 20 2d 31 29 20 28 65 71 3f 20 = redn -1) (eq? 4040: 6e 65 78 74 2d 63 61 74 20 65 6e 64 2d 6d 61 72 next-cat end-mar 4050: 6b 65 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 ker)). 4060: 20 20 20 20 20 20 28 63 61 72 20 76 61 6c 73 29 (car vals) 4070: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 4080: 20 28 6c 65 74 2a 20 28 28 6c 20 28 76 65 63 74 (let* ((l (vect 4090: 6f 72 2d 72 65 66 20 72 75 6c 65 2d 6c 65 6e 67 or-ref rule-leng 40a0: 74 68 20 72 65 64 6e 29 29 0a 20 20 20 20 20 20 th redn)). 40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 40c0: 20 28 6e 65 77 2d 73 74 61 74 65 73 20 28 69 66 (new-states (if 40d0: 20 28 7a 65 72 6f 3f 20 6c 29 0a 20 20 20 20 20 (zero? l). 40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4100: 28 63 6f 6e 73 20 73 74 61 74 65 20 73 74 61 74 (cons state stat 4110: 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es). 4120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4130: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 73 (list-s 4140: 75 66 66 69 78 20 73 74 61 74 65 73 20 28 2d 20 uffix states (- 4150: 6c 20 31 29 29 29 29 29 0a 20 20 20 20 20 20 20 l 1))))). 4160: 20 20 20 20 20 20 20 20 20 20 20 28 6d 6f 76 65 (move 4170: 2a 20 28 63 64 72 20 28 61 73 73 71 20 28 76 65 * (cdr (assq (ve 4180: 63 74 6f 72 2d 72 65 66 20 72 75 6c 65 2d 70 61 ctor-ref rule-pa 4190: 72 65 6e 74 20 72 65 64 6e 29 0a 20 20 20 20 20 rent redn). 41a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 41c0: 76 65 63 74 6f 72 2d 72 65 66 20 67 6f 74 6f 2d vector-ref goto- 41d0: 76 65 63 20 28 63 61 72 20 6e 65 77 2d 73 74 61 vec (car new-sta 41e0: 74 65 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 tes)))). 41f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4200: 20 6e 65 77 2d 73 74 61 74 65 73 0a 20 20 20 20 new-states. 4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4220: 20 20 20 20 20 28 63 6f 6e 73 20 28 61 70 70 6c (cons (appl 4230: 79 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 y (vector-ref ru 4240: 6c 65 2d 61 63 74 69 6f 6e 20 72 65 64 6e 29 0a le-action redn). 4250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 4270: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 28 (reverse ( 4280: 6c 69 73 74 2d 70 72 65 66 69 78 20 76 61 6c 73 list-prefix vals 4290: 20 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 l))). 42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 42b0: 20 20 20 20 20 28 6c 69 73 74 2d 73 75 66 66 69 (list-suffi 42c0: 78 20 76 61 6c 73 20 6c 29 29 29 29 29 0a 20 20 x vals l))))). 42d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 72 (par 42e0: 73 65 2d 65 72 72 6f 72 29 29 29 29 29 29 0a 20 se-error)))))). 42f0: 20 20 20 28 61 64 76 61 6e 63 65 2d 69 6e 70 75 (advance-inpu 4300: 74 29 0a 20 20 20 20 28 6d 6f 76 65 2a 20 30 20 t). (move* 0 4310: 27 28 29 20 27 28 29 29 29 29 0a '() '()))).