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