Annotation of gforth/gray.fs, revision 1.6
1.4 anton 1: \ recursive descent parser generator )
2:
1.6 ! anton 3: \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
1.3 pazsan 4: \ Copyright 1990, 1991, 1994 Martin Anton Ertl
1.1 anton 5:
1.3 pazsan 6: \ This program is free software; you can redistribute it and/or modify
7: \ it under the terms of the GNU General Public License as published by
8: \ the Free Software Foundation; either version 2 of the License, or
9: \ (at your option) any later version.
10:
11: \ This program is distributed in the hope that it will be useful,
12: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
13: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: \ GNU General Public License for more details.
15:
16: \ You should have received a copy of the GNU General Public License
17: \ along with this program; if not, write to the Free Software
18: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
1.1 anton 19:
1.3 pazsan 20: \ ANS FORTH prolog
21:
22: : defined? ( "word" -- flag ) bl word find nip ;
23: defined? WARNINGS 0=
24: [IF]
25: Variable warnings
26: warnings on
27: [THEN]
28:
29: \ end of ANS FORTH prolog
30:
1.2 pazsan 31: warnings @ [IF]
1.3 pazsan 32: .( Loading Gray ... Copyright 1990-1994 Martin Anton Ertl; NO WARRANTY ) cr
1.2 pazsan 33: [THEN]
1.1 anton 34:
35: \ misc )
36: : noop ;
37:
38: 1 cells constant cell
1.3 pazsan 39: s" address-unit-bits" environment? 0=
40: [IF]
41: warnings @ [IF]
42: cr .( environmental attribute address-units-bits unknown, computing... ) cr
43: [THEN]
44: \ if your machine has more bits/au, this assumption wastes space
45: \ if your machine has fewer bits/au, gray will not work
46: : (bits/cell) ( -- n ) 1 0 invert dup 1 rshift xor
47: BEGIN dup 1 = 0= WHILE 1 rshift swap 1+ swap REPEAT drop ;
48: (bits/cell)
49: warnings @ [IF]
50: .( You seem to have ) dup 1 cells / . .( bits/address unit) cr
51: [THEN]
52: [ELSE]
53: cells
54: [THEN]
55: constant bits/cell \ !! implementation dependent )
1.1 anton 56:
57: : ?not? ( f -- f )
1.3 pazsan 58: postpone 0= ; immediate
1.1 anton 59:
60: : 2, ( w1 w2 -- )
61: here 2 cells allot 2! ;
62:
63: : endif postpone then ; immediate
64:
65: : ?pairs ( n1 n2 -- )
66: ( aborts, if the numbers are not equal )
67: = ?not? abort" mismatched parenthesis" ;
68:
69: : ', \ -- ) ( use: ', name )
70: ' , ;
71:
72: 1 0= constant false
73: 0 0= constant true
74:
75: \ stack administration )
76: \ this implementation is completely unsafe )
77:
78: : stack \ n -- )
79: \ use: n stack word )
80: \ creates a stack called word with n cells )
81: \ the first cell is the stackpointer )
82: create here , cells allot ;
83:
84: : push \ n stack -- )
85: cell over +! @ ! ;
86:
87: : top \ stack -- n )
88: @ @ ;
89:
90: : pop \ stack -- )
91: [ -1 cells ] literal swap +! ;
92:
93: : clear? \ stack -- f )
94: dup @ = ;
95:
96: : clear \ stack -- )
97: dup ! ;
98:
99:
100: \ sets - represented as bit arrays )
101: \ bits that represent no elements, must be 0 )
102: \ all operations assume valid parameters )
103: \ elements must be unsigned numbers )
104: \ the max. element size must be declared with max-member )
105: \ no checking is performed )
106: \ set operations allot memory )
107:
108: : decode \ u -- w )
109: \ returns a cell with bit# u set and everyting else clear )
110: 1 swap lshift ;
111:
112: variable cells/set 0 cells/set !
113: variable empty-ptr 0 empty-ptr ! \ updatd by max-member )
114: : empty \ -- set )
115: empty-ptr @ ;
116:
117: : max-member \ u -- )
118: \ declares u to be the maximum member of sets generated afterwards )
119: \ must be called before using any set word except member?, add-member )
120: bits/cell / 1+
121: dup cells/set !
122: here empty-ptr ! \ make empty set )
123: 0 do 0 , loop ;
124:
125: : copy-set \ set1 -- set2 )
126: \ makes a copy of set1 )
127: here swap
128: cells/set @ 0 do
129: dup @ ,
130: cell+ loop
131: drop ;
132:
133: : normalize-bit-addr \ addr1 u1 -- addr2 u2 )
134: \ addr1*bits/cell+u1=addr2*bits/cell+u2, u2<bits/cell )
135: bits/cell /mod
136: cells rot +
137: swap ;
1.3 pazsan 138: \ the /mod could be optimized into a RSHIFT and an AND, if bits/cell is
139: \ a power of 2, but in an interpreted implementation this would only be
140: \ faster if the machine has very slow division and in a native code
141: \ implementation the compiler should be intelligent enough to optimize
142: \ without help.
1.1 anton 143:
144: : add-member \ u set -- )
145: \ changes set to include u )
146: swap normalize-bit-addr
147: decode
148: over @ or swap ! ;
149:
150: : singleton \ u -- set )
151: \ makes a set that contains u and nothing else )
152: empty copy-set swap over add-member ;
153:
154: : member? \ set u -- f )
155: \ returns true if u is in set )
156: normalize-bit-addr
157: decode
158: swap @ and
159: 0= ?not? ;
160:
161: : binary-set-operation \ set1 set2 [w1 w2 -- w3] -- set )
162: \ creates set from set1 and set2 by applying [w1 w2 -- w3] on members )
163: \ e.g. ' or binary-set-operation is the union operation )
164: here >r
165: cells/set @ 0 do >r
166: over @ over @ r@ execute ,
167: cell+ swap cell+ swap
168: r> loop
169: drop 2drop r> ;
170:
171: : union1 \ set1 set2 -- set )
172: ['] or binary-set-operation ;
173:
174: : intersection \ set1 set2 -- set )
175: ['] and binary-set-operation ;
176:
177: : binary-set-test? \ set1 set2 [w1 w2 -- w3] -- f )
178: \ returns true, if [w1 w2 -- w3] binary-set-operation returns empty )
179: \ e.g. set1 set2 ' and binary-set-test? is true, if set1 and set2
180: \ are disjoint, i.e. they contain no common members )
181: >r true rot rot r>
182: cells/set @ 0 do >r
183: over @ over @ r@ execute 0= ?not? if
184: rot drop false rot rot
185: endif
186: cell+ swap cell+ swap
187: r> loop
188: drop 2drop ;
189:
190: : notb&and \ w1 w2 -- w3 )
191: -1 xor and ;
192:
193: : subset? \ set1 set2 -- f )
194: \ returns true if every member of set1 is in set2 )
195: ['] notb&and binary-set-test? ;
196:
197: : disjoint? \ set1 set2 -- f )
198: \ returns true if set1 and set2 heve no common members )
199: ['] and binary-set-test? ;
200:
201: : apply-to-members \ set [ u -- ] -- )
202: \ executes [ u -- ] for every member of set )
203: cells/set @ bits/cell * 0 do
204: over i member? if
205: i over execute
206: endif
207: loop
208: 2drop ;
209:
210: : union \ set1 set2 -- set )
211: \ just a little more space-efficient )
212: 2dup subset? if
213: swap drop
214: else 2dup swap subset? if
215: drop
216: else
217: union1
218: endif endif ;
219:
220:
221: \ tests )
222: variable test-vector ' abort test-vector !
223: \ here you should store the execution address of a word ( set -- f )
224: \ that returns true if the token of the current symbol is in set )
225:
226: : compile-test \ set -- )
227: postpone literal
228: test-vector @ compile, ;
229:
230:
231: \ context management )
232: 500 stack context-stack
233: \ this stack holds the syntax-exprs currently being treated )
234: \ enlarge it, if your grammar is large and complex )
235: context-stack clear
236:
237: : this \ -- syntax-expr )
238: \ get current syntax-expr )
239: context-stack top ;
240:
241: : new-context \ syntax-expr -- )
242: context-stack push ;
243:
244: : old-context \ -- )
245: context-stack pop ;
246:
247:
248: \ structures )
249: : <builds-field \ n1 n2 -- n3 ) ( defining-word )
250: \ n1 is the offset of the field, n2 its length, n3 the offset of the
251: \ next field; creates a word that contains the offset )
252: create over , + ;
253:
254: 0 constant struct
255: \ initial offset
256:
257: : context-var \ use: < offset > size context-var name < offset2 > )
258: \ name returns the address of the offset field of "this" )
259: <builds-field \ n1 n2 -- n3 )
260: does> \ -- addr )
261: @ this + ;
262:
263: : context-const \ use: < offset > context-const name < offset2 > )
264: \ name returns the contents of the field of this at offset )
265: cell <builds-field \ n1 -- n2 )
266: does> \ -- n )
267: @ this + @ ;
268:
269:
270: \ syntax-exprs )
271: struct
272: aligned context-const methods
273: \ table of words applicable to the syntax-expr (a map)
274: 1 context-var mark-propagate \ used to ensure that "propagate" is
275: \ called at least once for each syntax-expr )
276: 1 context-var mark-pass2
277: \ make sure pass2 is called exactly once )
278: aligned cell context-var first-set
279: \ all tokens a nonempty path may begin with )
280: \ if it's equal to 0, the first-set has not been computed yet )
281: 1 context-var maybe-empty
282: \ true if the syntax-expr can derive eps )
283: aligned cell context-var follow-set
284: \ the tokens of the terminals that can follow the syntax-expr )
1.3 pazsan 285: s" gforth" environment?
286: [IF] 2drop \ clear gforth's version numbers )
1.1 anton 287: aligned 2 cells context-var source-location \ for error msgs )
1.3 pazsan 288: [ELSE]
289: s" bigFORTH" environment?
290: [IF] 2drop \ clear bigFORTH' version numbers )
291: aligned cell context-var source-location
292: \ for error msgs
293: [ELSE]
294: \ !! replace the stuff until constant with something working on your system
295: aligned 3 cells context-var source-location
296: \ for error msgs
297: 80 chars context-var error-info
298: \ string
299: [THEN] [THEN]
300: aligned constant syntax-expr \ length of a syntax-expr )
1.1 anton 301:
302: : make-syntax-expr \ map -- syntax-expr )
303: \ allocate a syntax-expr and initialize it )
304: here swap , false c, false c,
305: align 0 , false c, align empty ,
1.3 pazsan 306: \ source location. !! replace the stuff until `;' with your stuff
1.1 anton 307: \ if you use blocks, use:
308: \ blk @ >in @ 2,
309: \ the following is just a dummy
1.3 pazsan 310: [ s" gforth" environment? ]
311: [IF] [ 2drop ]
1.5 anton 312: 0 sourceline# 2,
1.3 pazsan 313: [ELSE]
314: [ s" bigFORTH" environment? ]
315: [IF] [ 2drop ]
316: makeview w, >in @ w,
317: [ELSE]
318: source 80 min >r here 3 cells + r@ cmove
319: here 3 cells + , r@ , >in @ 80 min , r> chars allot align
320: [THEN] [THEN]
1.1 anton 321: ;
322:
323:
324: \ warnings and errors )
325: : .in \ -- )
326: \ !! implementation dependent )
327: \ prints the info stored in source-location in a usable way )
328: \ prints where the error happened )
1.3 pazsan 329: [ s" gforth" environment? ]
330: [IF] [ 2drop ]
1.1 anton 331: source-location 2@ ." line" . drop ." :" ;
1.3 pazsan 332: [ELSE]
333: [ s" bigFORTH" environment? ]
334: [IF] [ 2drop ]
335: source-location dup w@ $3FF and scr ! 2+ w@ r# ! ;
336: [ELSE]
337: source-location 2@ swap cr type cr
338: error-info @ 2 - spaces ." ^" cr ." ::: " ;
339: [THEN] [THEN]
1.1 anton 340:
341: : gray-error abort ;
342:
343: : internal-error
344: cr .in ." you found a bug" gray-error ;
345:
346: variable print-token ' . print-token !
347: \ contains execution address of a word < token -- > to print a token )
348:
349: : check-conflict \ set1 set2 -- )
350: \ print the intersection of set1 and set2 if it isn't empty )
1.2 pazsan 351: 2dup disjoint? ?not? warnings @ and if
1.1 anton 352: cr .in ." conflict:"
353: intersection print-token @ apply-to-members
354: else
355: 2drop
356: endif ;
357:
358:
359: \ methods and maps )
360: : method \ use: < offset > method name < offset2 > )
361: \ executes the word whose execution address is stored in the field
362: \ at offset of a table pointed to by the "methods" field of "this" )
363: cell <builds-field \ n1 -- n2 )
364: does>
365: @ methods + @ execute ;
366:
367: \ method table for syntax-exprs
368: struct
369: method compute-method
370: method propagate-method
371: method generate-method
372: method pass2-method
373: constant syntax-expr-methods
374:
375:
376: \ general routines )
377: : compute \ syntax-expr -- first-set maybe-empty )
378: \ compute the first-set and maybe-empty of a syntax-expr )
379: \ a bit of memoization is used here )
380: new-context
381: first-set @ 0= if
382: compute-method
383: maybe-empty c!
384: first-set !
385: endif
386: first-set @ maybe-empty c@
387: old-context ;
388:
389: : get-first \ syntax-expr -- first-set )
390: compute drop ;
391:
392: : check-cycle \ syntax-expr -- )
393: \ just check for left recursion )
394: compute 2drop ;
395:
396: : propagate \ follow-set syntax-expr -- )
397: \ add follow-set to the follow set of syntax-expr and its children )
398: new-context
399: dup follow-set @ subset? ?not? \ would everything stay the same
400: mark-propagate c@ ?not? or if \ and was propagate here already
401: true mark-propagate c! \ NO, do propagate
402: follow-set @ union dup follow-set !
403: propagate-method
404: else
405: drop
406: endif
407: old-context ;
408:
409: : generate \ syntax-expr -- )
410: \ this one gets things done )
411: new-context generate-method old-context ;
412:
413: : pass2 \ syntax-expr -- )
414: \ computes all necessary first sets, checks for left recursions
415: \ and conflicts and generates code for rules )
416: new-context
417: mark-pass2 c@ ?not? if
418: true mark-pass2 c!
419: this check-cycle
420: pass2-method
421: endif
422: old-context ;
423:
424:
425: \ main routine )
426: : parser \ syntax-expr -- )
427: \ use: syntax-expr parser xxx )
428: context-stack clear
429: empty over propagate
430: dup pass2
431: \ : should not be immediate
432: >r : r> generate postpone ; ;
433:
434:
435: \ eps - empty syntax-expr )
436: create eps-map
437: ', internal-error
438: ', drop
439: ', noop
440: ', noop
441:
442:
443: create eps1
444: \ the eps syntax-expr proper
445: eps-map make-syntax-expr
446: drop
447:
448:
449: : eps \ -- syntax-expr )
450: \ just adjusts eps1 and returns it
451: eps1 new-context
452: empty first-set ! ( empty changes due to max-member )
453: empty follow-set !
454: true maybe-empty c!
455: old-context
456: eps1 ;
457:
458:
459: \ terminals )
460: \ a terminal is a syntax-expr with an extra field )
461: syntax-expr
462: context-const check&next
463: \ contains address of a word < f -- > that checks
464: \ if f is true and reads the next terminal symbol )
465: constant terminal-syntax-expr
466:
467: : generate-terminal \ -- )
468: this get-first compile-test
469: check&next compile, ;
470:
471: create terminal-map
472: ', internal-error
473: ', drop
474: ', generate-terminal
475: ', noop
476:
477: : make-terminal \ first-set cfa -- syntax-expr )
478: terminal-map make-syntax-expr
479: new-context
480: ,
481: first-set !
482: this old-context ;
483:
484: : terminal \ first-set cfa -- )
485: create make-terminal drop ;
486:
487:
488: \ binary syntax-exprs )
489: syntax-expr
490: context-const operand1
491: context-const operand2
492: constant binary-syntax-expr
493:
494: : make-binary \ syntax-expr1 syntax-expr2 map -- syntax-expr )
495: make-syntax-expr rot , swap , ;
496:
497: : pass2-binary
498: operand1 pass2
499: operand2 pass2 ;
500:
501:
502: \ concatenations )
503: : compute-concatenation \ -- first maybe-empty )
504: operand1 compute dup if
505: drop
506: operand2 compute
507: >r union r>
508: endif ;
509:
510: : propagate-concatenation \ follow-set -- )
511: operand2 compute if
512: over union
513: endif \ follow follow1 )
514: operand1 propagate
515: operand2 propagate ;
516:
517: : generate-concatenation \ -- )
518: operand1 generate
519: operand2 generate ;
520:
521: create concatenation-map
522: ', compute-concatenation
523: ', propagate-concatenation
524: ', generate-concatenation
525: ', pass2-binary
526:
527: : concat \ syntax-expr1 syntax-expr2 -- syntax-expr )
528: concatenation-map make-binary ;
529: \ this is the actual concatenation operator )
530: \ but for safety and readability the parenthesised notation )
531: \ is preferred )
532:
533:
534: \ alternatives )
535: : compute-alternative \ -- first maybe-empty )
536: operand1 compute
537: operand2 compute
1.2 pazsan 538: rot 2dup and warnings @ and if
1.1 anton 539: cr .in ." warning: two branches may be empty" endif
540: or >r union r> ;
541:
542: : propagate-alternative \ follow -- )
543: dup operand1 propagate
544: operand2 propagate ;
545:
546: : generate-alternative1 \ -- )
547: operand1 get-first compile-test
548: postpone if
549: operand1 generate
550: postpone else
551: operand2 generate
552: postpone endif ;
553:
554: : generate-alternative2 \ -- )
555: operand1 get-first compile-test postpone ?not?
556: operand2 get-first compile-test postpone and
557: postpone if
558: operand2 generate
559: postpone else
560: operand1 generate
561: postpone endif ;
562:
563: : generate-alternative \ -- )
564: operand1 compute if
565: generate-alternative2
566: else
567: generate-alternative1
568: endif
569: drop ;
570:
571: : pass2-alternative \ -- )
572: this compute if
573: follow-set @ check-conflict
574: else
575: drop
576: endif
577: operand1 get-first operand2 get-first check-conflict
578: pass2-binary ;
579:
580: create alternative-map
581: ', compute-alternative
582: ', propagate-alternative
583: ', generate-alternative
584: ', pass2-alternative
585:
586: : alt \ syntax-expr1 syntax-expr2 -- syntax-expr )
587: alternative-map make-binary ;
588: \ this is the actual alternative operator )
589: \ but for safety and readability the parenthesised notation )
590: \ is preferred )
591:
592:
593: \ unary syntax-exprs )
594: syntax-expr
595: context-const operand
596: constant unary-syntax-expr
597:
598: : make-unary \ syntax-expr1 map -- syntax-expr2 )
599: make-syntax-expr swap , ;
600:
601:
602: \ options and repetitions )
603: : pass2-option&repetition \ -- )
604: follow-set @ operand get-first check-conflict
605: operand pass2 ;
606:
607:
608: \ options )
609: : compute-option \ -- set f )
1.2 pazsan 610: operand compute warnings @ and if
1.1 anton 611: cr .in ." warning: unnessesary option" endif
612: true ;
613:
614: : propagate-option \ follow -- )
615: operand propagate ;
616:
617: : generate-option \ -- )
618: operand get-first compile-test
619: postpone if
620: operand generate
621: postpone endif ;
622:
623: create option-map
624: ', compute-option
625: ', propagate-option
626: ', generate-option
627: ', pass2-option&repetition
628:
629: : ?? \ syntax-expr1 -- syntax-expr2 )
630: option-map make-unary ;
631:
632:
633: \ repetitions )
634: : propagate-repetition \ follow-set -- )
635: operand get-first union operand propagate ;
636:
637:
638: \ *-repetitions )
639: : compute-*repetition \ -- set f )
1.2 pazsan 640: operand compute warnings @ and if
1.1 anton 641: cr .in ." warning: *repetition of optional term" endif
642: true ;
643:
644: : generate-*repetition \ -- )
645: postpone begin
646: operand get-first compile-test
647: postpone while
648: operand generate
649: postpone repeat ;
650:
651: create *repetition-map
652: ', compute-*repetition
653: ', propagate-repetition
654: ', generate-*repetition
655: ', pass2-option&repetition
656:
657: : ** \ syntax-expr1 -- syntax-expr2 )
658: *repetition-map make-unary ;
659:
660:
661: \ +-repetitions )
662: : compute-+repetition \ -- set f )
663: operand compute ;
664:
665: : generate-+repetition \ -- )
666: postpone begin
667: operand generate
668: operand get-first compile-test
669: postpone ?not? postpone until ;
670:
671: create +repetition-map
672: ', compute-+repetition
673: ', propagate-repetition
674: ', generate-+repetition
675: ', pass2-option&repetition
676:
677: : ++ \ syntax-expr1 -- syntax-expr2 )
678: +repetition-map make-unary ;
679:
680:
681: \ actions )
682: syntax-expr
683: context-const action
684: constant action-syntax-expr
685:
686: : generate-action \ syntax-expr -- )
687: action compile, ;
688:
689: create action-map
690: ', internal-error
691: ', drop
692: ', generate-action
693: ', noop
694:
695: : {{ \ -- syntax-expr addr colon-sys )
696: action-map make-syntax-expr
697: new-context
698: empty first-set !
699: true maybe-empty c!
700: this old-context
701: \ ?exec !csp )
702: here cell allot
703: :noname ;
704:
705: : }} \ syntax-expr addr colon-sys -- syntax-expr )
706: \ ?csp )
707: postpone ;
708: swap !
709: ; immediate
710:
711:
712: \ nonterminals )
713: syntax-expr
714: 1 context-var mark-compute
715: aligned cell context-var rule-body \ in forth left side of rule )
716: cell context-var exec \ cfa of code for rule )
717: constant nt-syntax-expr
718:
719: : get-body \ -- syntax-expr )
720: \ get the body of the rule for the nt in "this" )
721: rule-body @ if
722: rule-body @
723: else
724: cr .in ." no rule for nonterminal" gray-error
725: endif ;
726:
727: : compute-nt \ -- set f )
728: mark-compute c@ if
729: cr .in ." left recursion" gray-error
730: else
731: true mark-compute c!
732: get-body compute
733: endif ;
734:
735: : propagate-nt \ follow-set -- )
736: get-body propagate ;
737:
738: : code-nt \ -- )
739: \ generates the code for a rule )
740: :noname
741: get-body generate
742: postpone ;
743: exec ! ;
744:
745: : generate-nt \ -- )
746: \ generates a call to the code for the rule )
747: \ since the code needs not be generated yet, an indirect call is used )
748: exec postpone literal
749: postpone @
750: postpone execute ;
751:
752: : pass2-nt \ -- )
753: \ apart from the usual duties, this pass2 also has to code-nt )
754: get-body pass2
755: code-nt ;
756:
757: create nt-map
758: ', compute-nt
759: ', propagate-nt
760: ', generate-nt
761: ', pass2-nt
762:
763: : make-nt \ syntax-expr -- nt )
764: nt-map make-syntax-expr
765: false c, align swap , 0 , ;
766:
767: : <- \ use: syntax-expr <- xxx )
768: \ xxx: -- syntax-expr )
769: create make-nt drop ;
770:
771: : nonterminal \ use: nonterminal xxx )
772: 0 <- ; \ forward declaration )
773:
774: : rule \ syntax-expr nt -- )
775: \ makes a rule )
776: new-context
777: rule-body @ if
778: .in ." multiple rules for nonterminal" gray-error endif
779: rule-body !
780: old-context ;
781:
782:
783: \ syntactic sugar )
784: : reduce \ 0 x1 ... [x2 x3 -- x4] -- x )
785: \ e.g. 0 5 6 7 ' + reduce = 5 6 7 + + = 18 )
786: >r dup 0= if
787: ." no operand" abort
788: endif
789: begin
790: over 0= ?not? while
791: r@ execute
792: repeat \ 0 x )
793: swap drop r> drop ;
794:
795: 7 constant concatenation-id
796: : (- \ -- n 0 )
797: concatenation-id 0 ;
798: : -) \ n 0 syntax-expr1 syntax-expr2 .. -- syntax-expr )
799: ['] concat reduce
800: swap concatenation-id ?pairs ;
801:
802: 8 constant alternative-id
803: : (| \ -- n 0 )
804: alternative-id 0 ;
805: : |) \ n 0 syntax-expr1 syntax-expr2 .. -- syntax-expr )
806: ['] alt reduce
807: swap alternative-id ?pairs ;
808:
809: : (( (| (- ;
810: : )) -) |) ;
811: : || -) (- ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>