Artifact 89949d7adc1ddd11fd20a132d91e3a2fd003f48c:
- File lalr/lalr-test.ss — part of check-in [89d5aac0dc] at 2016-08-17 07:45:09 on branch trunk — added lalr (user: ovenpasta@pizzahack.eu size: 2221)
0000: 3b 3b 3b 20 6c 61 6c 72 2d 74 65 73 74 2e 73 73 ;;; lalr-test.ss 0010: 20 2d 20 41 6e 20 65 78 61 6d 70 6c 65 20 66 69 - An example fi 0020: 6c 65 20 73 68 6f 77 69 6e 67 20 68 6f 77 20 74 le showing how t 0030: 68 65 20 6c 61 6c 72 20 70 61 72 73 65 72 20 63 he lalr parser c 0040: 61 6e 20 62 65 20 75 73 65 64 2e 0a 3b 3b 3b 0a an be used..;;;. 0050: 3b 3b 3b 20 41 6e 20 65 78 61 6d 70 6c 65 20 75 ;;; An example u 0060: 73 69 6e 67 20 74 68 65 20 6c 61 6c 72 20 70 61 sing the lalr pa 0070: 72 73 65 72 2e 20 20 54 68 69 73 20 66 69 6c 65 rser. This file 0080: 20 64 65 66 69 6e 65 73 20 74 68 65 20 66 75 6e defines the fun 0090: 63 74 69 6f 6e 0a 3b 3b 3b 20 65 76 61 6c 2d 73 ction.;;; eval-s 00a0: 74 72 69 6e 67 2c 20 77 68 69 63 68 20 74 61 6b tring, which tak 00b0: 65 73 20 61 20 73 74 72 69 6e 67 20 72 65 70 72 es a string repr 00c0: 65 73 65 6e 74 69 6e 67 20 61 20 73 69 6d 70 6c esenting a simpl 00d0: 65 20 61 72 69 74 68 6d 65 74 69 63 0a 3b 3b 3b e arithmetic.;;; 00e0: 20 65 78 70 72 65 73 73 69 6f 6e 20 61 6e 64 20 expression and 00f0: 72 65 74 75 72 6e 73 20 69 74 73 20 76 61 6c 75 returns its valu 0100: 65 2e 20 20 45 2e 67 2e 0a 3b 3b 3b 0a 3b 3b 3b e. E.g..;;;.;;; 0110: 20 28 65 76 61 6c 2d 73 74 72 69 6e 67 20 22 20 (eval-string " 0120: 34 35 20 2b 20 37 36 20 2a 20 32 20 22 29 20 3d 45 + 76 * 2 ") = 0130: 3d 3e 20 31 39 37 0a 3b 3b 3b 0a 3b 3b 3b 20 54 => 197.;;;.;;; T 0140: 6f 20 70 72 6f 64 75 63 65 20 61 6e 20 65 78 70 o produce an exp 0150: 72 65 73 73 69 6f 6e 20 64 65 66 69 6e 69 6e 67 ression defining 0160: 20 74 68 65 20 70 61 72 73 65 20 74 61 62 6c 65 the parse table 0170: 20 77 68 69 63 68 20 79 6f 75 20 63 6f 75 6c 64 which you could 0180: 20 63 6f 6d 70 69 6c 65 2c 20 0a 3b 3b 3b 20 63 compile, .;;; c 0190: 68 61 6e 67 65 20 74 68 65 20 62 61 63 6b 71 75 hange the backqu 01a0: 6f 74 65 20 74 6f 20 61 20 71 75 6f 74 65 20 69 ote to a quote i 01b0: 6e 20 74 68 65 20 64 65 66 69 6e 69 74 69 6f 6e n the definition 01c0: 20 6f 66 20 65 78 70 72 2d 67 72 61 6d 6d 61 72 of expr-grammar 01d0: 2c 0a 3b 3b 3b 20 61 6e 64 20 65 76 61 6c 75 61 ,.;;; and evalua 01e0: 74 65 0a 3b 3b 3b 0a 3b 3b 3b 20 60 28 64 65 66 te.;;;.;;; `(def 01f0: 69 6e 65 20 74 61 62 6c 65 20 2c 28 6c 69 73 74 ine table ,(list 0200: 20 27 71 75 61 73 69 71 75 6f 74 65 20 28 6c 61 'quasiquote (la 0210: 6c 72 2d 74 61 62 6c 65 20 65 78 70 72 2d 67 72 lr-table expr-gr 0220: 61 6d 6d 61 72 20 65 78 70 72 2d 74 65 72 6d 69 ammar expr-termi 0230: 6e 61 6c 73 20 23 66 29 29 29 0a 3b 3b 3b 0a 3b nals #f))).;;;.; 0240: 3b 3b 20 42 65 20 73 75 72 65 20 74 6f 20 69 6e ;; Be sure to in 0250: 63 6c 75 64 65 20 61 6e 79 20 70 72 6f 63 65 64 clude any proced 0260: 75 72 65 73 20 72 65 66 65 72 65 6e 63 65 64 20 ures referenced 0270: 69 6e 20 65 78 70 72 2d 67 72 61 6d 6d 61 72 20 in expr-grammar 0280: 28 69 6e 20 74 68 69 73 0a 3b 3b 3b 20 65 78 61 (in this.;;; exa 0290: 6d 70 6c 65 2c 20 62 69 6e 61 72 79 2d 61 70 70 mple, binary-app 02a0: 6c 79 20 61 6e 64 20 69 64 65 6e 74 69 74 79 29 ly and identity) 02b0: 0a 0a 28 64 65 66 69 6e 65 20 28 62 69 6e 61 72 ..(define (binar 02c0: 79 2d 61 70 70 6c 79 20 65 78 70 72 31 20 6f 70 y-apply expr1 op 02d0: 20 65 78 70 72 32 29 20 28 6f 70 20 65 78 70 72 expr2) (op expr 02e0: 31 20 65 78 70 72 32 29 29 0a 28 64 65 66 69 6e 1 expr2)).(defin 02f0: 65 20 28 69 64 65 6e 74 69 74 79 20 65 78 70 72 e (identity expr 0300: 29 20 65 78 70 72 29 0a 0a 28 64 65 66 69 6e 65 ) expr)..(define 0310: 20 65 78 70 72 2d 67 72 61 6d 6d 61 72 0a 20 20 expr-grammar. 0320: 60 28 28 65 78 70 72 20 2d 2d 3e 20 65 78 70 72 `((expr --> expr 0330: 20 65 78 70 72 2d 6f 70 20 74 65 72 6d 20 2c 62 expr-op term ,b 0340: 69 6e 61 72 79 2d 61 70 70 6c 79 29 20 20 20 20 inary-apply) 0350: 3b 3b 3b 20 63 68 61 6e 67 65 20 60 20 74 6f 20 ;;; change ` to 0360: 27 0a 20 20 20 20 28 65 78 70 72 20 2d 2d 3e 20 '. (expr --> 0370: 74 65 72 6d 20 2c 69 64 65 6e 74 69 74 79 29 20 term ,identity) 0380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0390: 20 20 20 20 3b 3b 3b 20 69 66 20 79 6f 75 20 77 ;;; if you w 03a0: 61 6e 74 20 74 6f 20 67 65 6e 65 72 61 74 65 0a ant to generate. 03b0: 20 20 20 20 28 74 65 72 6d 20 2d 2d 3e 20 74 65 (term --> te 03c0: 72 6d 20 74 65 72 6d 2d 6f 70 20 74 65 72 6d 30 rm term-op term0 03d0: 20 2c 62 69 6e 61 72 79 2d 61 70 70 6c 79 29 20 ,binary-apply) 03e0: 20 20 3b 3b 3b 20 61 20 53 63 68 65 6d 65 20 70 ;;; a Scheme p 03f0: 72 6f 67 72 61 6d 20 74 61 62 6c 65 0a 20 20 20 rogram table. 0400: 20 28 74 65 72 6d 20 2d 2d 3e 20 74 65 72 6d 30 (term --> term0 0410: 20 2c 69 64 65 6e 74 69 74 79 29 0a 20 20 20 20 ,identity). 0420: 28 74 65 72 6d 30 20 2d 2d 3e 20 6c 70 61 72 65 (term0 --> lpare 0430: 6e 20 65 78 70 72 20 72 70 61 72 65 6e 20 2c 28 n expr rparen ,( 0440: 6c 61 6d 62 64 61 20 28 6c 70 20 65 78 70 72 20 lambda (lp expr 0450: 72 70 29 20 65 78 70 72 29 29 0a 20 20 20 20 28 rp) expr)). ( 0460: 74 65 72 6d 30 20 2d 2d 3e 20 6e 75 6d 62 65 72 term0 --> number 0470: 20 2c 69 64 65 6e 74 69 74 79 29 0a 20 20 20 20 ,identity). 0480: 28 6e 75 6d 62 65 72 20 2d 2d 3e 20 6e 75 6d 62 (number --> numb 0490: 65 72 20 64 69 67 69 74 20 2c 28 6c 61 6d 62 64 er digit ,(lambd 04a0: 61 20 28 6e 20 64 29 20 28 2b 20 28 2a 20 31 30 a (n d) (+ (* 10 04b0: 20 6e 29 20 64 29 29 29 0a 20 20 20 20 28 6e 75 n) d))). (nu 04c0: 6d 62 65 72 20 2d 2d 3e 20 64 69 67 69 74 20 2c mber --> digit , 04d0: 69 64 65 6e 74 69 74 79 29 29 29 0a 0a 28 64 65 identity)))..(de 04e0: 66 69 6e 65 20 65 78 70 72 2d 74 65 72 6d 69 6e fine expr-termin 04f0: 61 6c 73 20 27 28 65 78 70 72 2d 6f 70 20 74 65 als '(expr-op te 0500: 72 6d 2d 6f 70 20 6c 70 61 72 65 6e 20 72 70 61 rm-op lparen rpa 0510: 72 65 6e 20 64 69 67 69 74 29 29 0a 0a 28 64 65 ren digit))..(de 0520: 66 69 6e 65 20 74 61 62 6c 65 20 28 6c 61 6c 72 fine table (lalr 0530: 2d 74 61 62 6c 65 20 65 78 70 72 2d 67 72 61 6d -table expr-gram 0540: 6d 61 72 20 65 78 70 72 2d 74 65 72 6d 69 6e 61 mar expr-termina 0550: 6c 73 20 23 66 29 29 0a 0a 28 64 65 66 69 6e 65 ls #f))..(define 0560: 20 28 65 76 61 6c 2d 73 74 72 69 6e 67 20 73 74 (eval-string st 0570: 72 69 6e 67 29 0a 20 20 28 6c 65 74 20 28 28 70 ring). (let ((p 0580: 6f 73 20 30 29 29 0a 20 20 20 20 28 64 65 66 69 os 0)). (defi 0590: 6e 65 20 28 6c 65 78 69 63 61 6c 2d 61 6e 61 6c ne (lexical-anal 05a0: 79 73 65 72 29 0a 20 20 20 20 20 20 28 69 66 20 yser). (if 05b0: 28 3c 20 70 6f 73 20 28 73 74 72 69 6e 67 2d 6c (< pos (string-l 05c0: 65 6e 67 74 68 20 73 74 72 69 6e 67 29 29 0a 20 ength string)). 05d0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 68 (let ((ch 05e0: 61 72 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 ar (string-ref s 05f0: 74 72 69 6e 67 20 70 6f 73 29 29 29 0a 20 20 20 tring pos))). 0600: 20 20 20 20 20 20 20 28 73 65 74 21 20 70 6f 73 (set! pos 0610: 20 28 2b 20 70 6f 73 20 31 29 29 0a 20 20 20 20 (+ pos 1)). 0620: 20 20 20 20 20 20 28 69 66 20 28 63 68 61 72 3d (if (char= 0630: 3f 20 63 68 61 72 20 23 5c 20 29 0a 20 20 20 20 ? char #\ ). 0640: 20 20 20 20 20 20 20 20 28 6c 65 78 69 63 61 6c (lexical 0650: 2d 61 6e 61 6c 79 73 65 72 29 0a 20 20 20 20 20 -analyser). 0660: 20 20 20 20 20 20 20 28 63 61 73 65 20 63 68 61 (case cha 0670: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r. 0680: 28 28 23 5c 2b 29 20 60 28 65 78 70 72 2d 6f 70 ((#\+) `(expr-op 0690: 20 2e 20 2c 2b 29 29 0a 20 20 20 20 20 20 20 20 . ,+)). 06a0: 20 20 20 20 20 20 28 28 23 5c 2d 29 20 60 28 65 ((#\-) `(e 06b0: 78 70 72 2d 6f 70 20 2e 20 2c 2d 29 29 0a 20 20 xpr-op . ,-)). 06c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\ 06d0: 2a 29 20 60 28 74 65 72 6d 2d 6f 70 20 2e 20 2c *) `(term-op . , 06e0: 2a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 *)). 06f0: 20 20 28 28 23 5c 2f 29 20 60 28 74 65 72 6d 2d ((#\/) `(term- 0700: 6f 70 20 2e 20 2c 2f 29 29 0a 20 20 20 20 20 20 op . ,/)). 0710: 20 20 20 20 20 20 20 20 28 28 23 5c 28 29 20 27 ((#\() ' 0720: 28 6c 70 61 72 65 6e 20 2e 20 23 66 29 29 0a 20 (lparen . #f)). 0730: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((# 0740: 5c 29 29 20 27 28 72 70 61 72 65 6e 20 2e 20 23 \)) '(rparen . # 0750: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)). 0760: 20 20 28 28 23 5c 30 20 23 5c 31 20 23 5c 32 20 ((#\0 #\1 #\2 0770: 23 5c 33 20 23 5c 34 20 23 5c 35 20 23 5c 36 20 #\3 #\4 #\5 #\6 0780: 23 5c 37 20 23 5c 38 20 23 5c 39 29 0a 20 20 20 #\7 #\8 #\9). 0790: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 64 69 `(di 07a0: 67 69 74 20 2e 20 2c 28 2d 20 28 63 68 61 72 2d git . ,(- (char- 07b0: 3e 69 6e 74 65 67 65 72 20 63 68 61 72 29 20 28 >integer char) ( 07c0: 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\ 07d0: 30 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 0)))). 07e0: 20 20 20 20 28 65 6c 73 65 20 28 70 61 72 73 65 (else (parse 07f0: 2d 65 72 72 6f 72 29 29 29 29 29 29 29 0a 20 20 -error))))))). 0800: 20 20 28 64 65 66 69 6e 65 20 28 70 61 72 73 65 (define (parse 0810: 2d 65 72 72 6f 72 29 0a 20 20 20 20 20 20 28 64 -error). (d 0820: 69 73 70 6c 61 79 20 22 45 72 72 6f 72 20 73 6f isplay "Error so 0830: 6d 65 77 68 65 72 65 20 69 6e 20 22 29 0a 20 20 mewhere in "). 0840: 20 20 20 20 28 77 72 69 74 65 20 28 73 75 62 73 (write (subs 0850: 74 72 69 6e 67 20 73 74 72 69 6e 67 20 30 20 70 tring string 0 p 0860: 6f 73 29 29 0a 20 20 20 20 20 20 28 6e 65 77 6c os)). (newl 0870: 69 6e 65 29 29 0a 20 20 20 20 28 6c 61 6c 72 2d ine)). (lalr- 0880: 70 61 72 73 65 72 20 74 61 62 6c 65 20 6c 65 78 parser table lex 0890: 69 63 61 6c 2d 61 6e 61 6c 79 73 65 72 20 70 61 ical-analyser pa 08a0: 72 73 65 2d 65 72 72 6f 72 29 29 29 0a rse-error))).