Fix peg left recursion handling

db4
Chris Double 2009-04-01 17:55:15 +13:00 committed by Slava Pestov
parent 474e74a232
commit 087a7acfba
1 changed files with 14 additions and 9 deletions

View File

@ -155,18 +155,21 @@ TUPLE: peg-head rule-id involved-set eval-set ;
dup pos>> pos set ans>>
; inline
:: (setup-lr) ( r l s -- )
s head>> l head>> eq? [
l head>> s (>>head)
l head>> [ s rule-id>> suffix ] change-involved-set drop
r l s next>> (setup-lr)
] unless ;
:: (setup-lr) ( l s -- )
s [
s left-recursion? [ s throw ] unless
s head>> l head>> eq? [
l head>> s (>>head)
l head>> [ s rule-id>> suffix ] change-involved-set drop
l s next>> (setup-lr)
] unless
] when ;
:: setup-lr ( r l -- )
l head>> [
r rule-id V{ } clone V{ } clone peg-head boa l (>>head)
] unless
r l lrstack get (setup-lr) ;
l lrstack get (setup-lr) ;
:: lr-answer ( r p m -- ast )
[let* |
@ -216,8 +219,10 @@ TUPLE: peg-head rule-id involved-set eval-set ;
lrstack get next>> lrstack set
pos get m (>>pos)
lr head>> [
ans lr (>>seed)
r p m lr-answer
m ans>> left-recursion? [
ans lr (>>seed)
r p m lr-answer
] [ ans ] if
] [
ans m (>>ans)
ans