author | Tony Garnock-Jones <tonyg@kcbbs.gen.nz> |
Thu, 31 Mar 2005 01:25:02 +1200 | |
changeset 0 | ea4e1a00864c |
permissions | -rw-r--r-- |
0
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
;; Packrat Parser Library |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
(require 'srfi-1) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
(define-record-type parse-result |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
(make-parse-result successful? semantic-value next error) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
parse-result? |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
(successful? parse-result-successful?) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
(semantic-value parse-result-semantic-value) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
(next parse-result-next) ;; #f, if eof or error; otherwise a parse-results |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
(error parse-result-error) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
;; ^^ #f if none, but usually a parse-error structure |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
(define-record-type parse-results |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
(make-parse-results position base next map) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
parse-results? |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
(position parse-results-position) ;; a parse-position or #f if unknown |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
(base parse-results-base) ;; a value, #f indicating 'none' or 'eof' |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
20 |
(next parse-results-next* set-parse-results-next!) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
21 |
;; ^^ a parse-results, or a nullary function delivering same, or #f for nothing next (eof) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
22 |
(map parse-results-map set-parse-results-map!) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
23 |
;; ^^ an alist mapping a nonterminal to a parse-result |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
24 |
) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
(define-record-type parse-error |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
(make-parse-error position expected-strings messages) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
parse-error? |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
(position parse-error-position) ;; a parse-position or #f if unknown |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
(expected-strings parse-error-expected-strings) ;; set of strings (lset) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
(messages parse-error-messages) ;; list of strings |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
(define-record-type parse-position |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
(make-parse-position file line column) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
parse-position? |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
(file parse-position-file) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
(line parse-position-line) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
(column parse-position-column)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
(define (top-parse-position filename) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
(make-parse-position filename 1 0)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
(define (update-parse-position pos ch) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
(if (not pos) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
#f |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
(let ((file (parse-position-file pos)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
(line (parse-position-line pos)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
(column (parse-position-column pos))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
50 |
(cond |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
51 |
((eq? ch #\return) (make-parse-position file line 0)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
((eq? ch #\newline) (make-parse-position file (+ line 1) 0)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
((eq? ch #\tab) (make-parse-position file line (* (quotient (+ column 8) 8) 8))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
(else (make-parse-position file line (+ column 1))))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
(define (parse-position->string pos) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
(if (not pos) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
"<??>" |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
(string-append (parse-position-file pos) ":" |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
(number->string (parse-position-line pos)) ":" |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
(number->string (parse-position-column pos))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
(define (empty-results pos) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
(make-parse-results pos #f #f '())) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
66 |
(define (make-results pos base next-generator) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
67 |
(make-parse-results pos base next-generator '())) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
68 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
69 |
(define (make-error-expected pos str) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
70 |
(make-parse-error pos (list str) '())) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
71 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
72 |
(define (make-error-message pos msg) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
73 |
(make-parse-error pos '() (list msg))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
74 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
75 |
(define (make-result semantic-value next) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
76 |
(make-parse-result #t semantic-value next #f)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
77 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
78 |
(define (make-expected-result pos str) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
79 |
(make-parse-result #f #f #f (make-error-expected pos str))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
80 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
81 |
(define (make-message-result pos msg) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
82 |
(make-parse-result #f #f #f (make-error-message pos msg))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
83 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
84 |
(define (prepend-base pos base next) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
85 |
(make-parse-results pos base next '())) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
86 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
87 |
(define (prepend-semantic-value pos key result next) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
88 |
(make-parse-results pos #f #f |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
89 |
(list (cons key (make-result result next))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
90 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
91 |
(define (base-generator->results generator) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
92 |
;; Note: applies first next-generator, to get first result |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
93 |
(define (results-generator) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
94 |
(let-values (((pos base) (generator))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
95 |
(if (not base) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
96 |
(empty-results pos) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
97 |
(make-results pos base results-generator)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
98 |
(results-generator)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
99 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
100 |
(define (parse-results-next results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
101 |
(let ((next (parse-results-next* results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
102 |
(if (procedure? next) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
103 |
(let ((next-value (next))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
104 |
(set-parse-results-next! results next-value) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
105 |
next-value) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
106 |
next))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
107 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
108 |
(define (results->result results key fn) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
109 |
(let ((results-map (parse-results-map results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
110 |
(cond |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
111 |
((assq key results-map) => cdr) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
112 |
(else (let ((result (fn))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
113 |
(set-parse-results-map! results (cons (cons key result) results-map)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
114 |
result))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
115 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
116 |
(define (parse-position>? a b) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
117 |
(cond |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
118 |
((not a) #f) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
119 |
((not b) #t) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
120 |
(else (let ((la (parse-position-line a)) (lb (parse-position-line b))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
121 |
(or (> la lb) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
122 |
(and (= la lb) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
123 |
(> (parse-position-column a) (parse-position-column b)))))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
124 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
125 |
(define (parse-error-empty? e) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
126 |
(and (null? (parse-error-expected-strings e)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
127 |
(null? (parse-error-messages e)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
128 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
129 |
(define (merge-parse-errors e1 e2) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
130 |
(cond |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
131 |
((not e1) e2) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
132 |
((not e2) e1) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
133 |
(else |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
134 |
(let ((p1 (parse-error-position e1)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
135 |
(p2 (parse-error-position e2))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
136 |
(cond |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
137 |
((or (parse-position>? p1 p2) (parse-error-empty? e2)) e1) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
138 |
((or (parse-position>? p2 p1) (parse-error-empty? e1)) e2) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
139 |
(else (make-parse-error p1 |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
140 |
(lset-union string=? |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
141 |
(parse-error-expected-strings e1) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
142 |
(parse-error-expected-strings e2)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
143 |
(append (parse-error-messages e1) (parse-error-messages e2))))))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
144 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
145 |
(define (merge-result-errors result errs) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
146 |
(make-parse-result (parse-result-successful? result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
147 |
(parse-result-semantic-value result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
148 |
(parse-result-next result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
149 |
(merge-parse-errors (parse-result-error result) errs))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
150 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
151 |
;--------------------------------------------------------------------------- |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
152 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
153 |
(define (parse-results-token-kind results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
154 |
(let ((base (parse-results-base results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
155 |
(and base (car base)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
156 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
157 |
(define (parse-results-token-value results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
158 |
(let ((base (parse-results-base results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
159 |
(and base (cdr base)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
160 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
161 |
(define (packrat-check-base token-kind k) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
162 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
163 |
(let ((base (parse-results-base results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
164 |
(if (eq? (and base (car base)) token-kind) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
165 |
((k (and base (cdr base))) (parse-results-next results)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
166 |
(make-expected-result (parse-results-position results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
167 |
(if (not token-kind) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
168 |
"end-of-file" |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
169 |
(symbol->string token-kind))))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
170 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
171 |
(define (packrat-check parser k) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
172 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
173 |
(let ((result (parser results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
174 |
(if (parse-result-successful? result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
175 |
(merge-result-errors ((k (parse-result-semantic-value result)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
176 |
(parse-result-next result)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
177 |
(parse-result-error result)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
178 |
result)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
179 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
180 |
(define (packrat-or p1 p2) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
181 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
182 |
(let ((result (p1 results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
183 |
(if (parse-result-successful? result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
184 |
result |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
185 |
(merge-result-errors (p2 results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
186 |
(parse-result-error result)))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
187 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
188 |
(define (packrat-unless explanation p1 p2) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
189 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
190 |
(let ((result (p1 results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
191 |
(if (parse-result-successful? result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
192 |
(make-message-result (parse-results-position results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
193 |
explanation) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
194 |
(p2 results))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
195 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
196 |
;--------------------------------------------------------------------------- |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
197 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
198 |
(define (object->external-representation o) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
199 |
(let ((s (open-output-string))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
200 |
(write o s) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
201 |
(get-output-string s))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
202 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
203 |
(define-syntax packrat-parser |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
204 |
(syntax-rules (<- quote ! @ /) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
205 |
((_ start (nonterminal (alternative body0 body ...) ...) ...) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
206 |
(let () |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
207 |
(define nonterminal |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
208 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
209 |
(results->result results 'nonterminal |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
210 |
(lambda () |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
211 |
((packrat-parser #f "alts" nonterminal |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
212 |
((begin body0 body ...) alternative) ...) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
213 |
results))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
214 |
... |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
215 |
start)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
216 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
217 |
((_ #f "alts" nt (body alternative)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
218 |
(packrat-parser #f "altD" nt body alternative)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
219 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
220 |
((_ #f "alts" nt (body alternative) rest0 rest ...) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
221 |
(packrat-or (packrat-parser #f "altD" nt body alternative) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
222 |
(packrat-parser #f "alts" nt rest0 rest ...))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
223 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
224 |
((_ #f "altD" nt body alternative) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
225 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
226 |
;;(write (list (parse-position->string (parse-results-position results)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
227 |
;;'trying- 'nt 'alternative)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
228 |
;;(newline) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
229 |
(let ((result ((packrat-parser #f "alt" nt body alternative) results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
230 |
;;(write (list (parse-position->string |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
231 |
;;(parse-results-position results)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
232 |
;;(if (parse-result-successful? result) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
233 |
;;'success |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
234 |
;;'failing) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
235 |
;;'nt 'alternative)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
236 |
;;(newline) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
237 |
result))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
238 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
239 |
((_ #f "alt" nt body ()) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
240 |
(lambda (results) (make-result body results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
241 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
242 |
((_ #f "alt" nt body ((! fails ...) rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
243 |
(packrat-unless (string-append "Nonterminal " (symbol->string 'nt) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
244 |
" expected to fail " |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
245 |
(object->external-representation '(fails ...))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
246 |
(packrat-parser #f "alt" nt #t (fails ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
247 |
(packrat-parser #f "alt" nt body (rest ...)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
248 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
249 |
((_ #f "alt" nt body ((/ alternative ...) rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
250 |
(packrat-check (packrat-parser #f "alts" nt (#t alternative) ...) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
251 |
(lambda (result) (packrat-parser #f "alt" nt body (rest ...))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
252 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
253 |
((_ #f "alt" nt body (var <- 'val rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
254 |
(packrat-check-base 'val |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
255 |
(lambda (var) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
256 |
(packrat-parser #f "alt" nt body (rest ...))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
257 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
258 |
((_ #f "alt" nt body (var <- @ rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
259 |
(lambda (results) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
260 |
(let ((var (parse-results-position results))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
261 |
((packrat-parser #f "alt" nt body (rest ...)) results)))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
262 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
263 |
((_ #f "alt" nt body (var <- val rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
264 |
(packrat-check val |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
265 |
(lambda (var) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
266 |
(packrat-parser #f "alt" nt body (rest ...))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
267 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
268 |
((_ #f "alt" nt body ('val rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
269 |
(packrat-check-base 'val |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
270 |
(lambda (dummy) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
271 |
(packrat-parser #f "alt" nt body (rest ...))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
272 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
273 |
((_ #f "alt" nt body (val rest ...)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
274 |
(packrat-check val |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
275 |
(lambda (dummy) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
276 |
(packrat-parser #f "alt" nt body (rest ...))))))) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
277 |
|
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
278 |
(define (x) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
279 |
(sc-expand |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
280 |
'(packrat-parser expr |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
281 |
(expr ((a <- 'num '+ b <- 'num) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
282 |
(+ a b)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
283 |
((a <- mulexp) a)) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
284 |
(mulexp ((a <- 'num '* b <- 'num) |
ea4e1a00864c
Initial version, from TLA arch@eighty-twenty.org--2004/smalltalk-tng--main--0--version-0
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
285 |
(* a b)))))) |