steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

update peg for [let change

db4
Joe Groff 2009-10-27 22:29:20 -05:00
parent 935c0797c3
commit f1d9201cb2
2 changed files with 24 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/peg/ebnf/ebnf.factor
View File

@ -445,16 +445,16 @@ M: ebnf-sequence build-locals ( code ast -- code )
drop
] [
[
"FROM: locals => [let* ; FROM: sequences => nth ; [let* | " %
dup length swap [
dup ebnf-var? [
"FROM: locals => [let ; FROM: sequences => nth ; [let " %
dup length [
over ebnf-var? [
" " % # " over nth :> " %
name>> %
" [ " % # " over nth ] " %
] [
2drop
] if
] 2each
" | " %
" " %
%
" nip ]" %
] "" make
@ -463,9 +463,9 @@ M: ebnf-sequence build-locals ( code ast -- code )
M: ebnf-var build-locals ( code ast -- )
[
"FROM: locals => [let* ; FROM: kernel => dup nip ; [let* | " %
name>> % " [ dup ] " %
" | " %
"FROM: locals => [let ; FROM: kernel => dup nip ; [let " %
" dup :> " % name>> %
" " %
%
" nip ]" %
] "" make ;

44
basis/peg/peg.factor
View File

@ -172,9 +172,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
l lrstack get (setup-lr) ;
:: lr-answer ( r p m -- ast )
[let* |
h [ m ans>> head>> ]
|
m ans>> head>> :> h
h rule-id>> r rule-id eq? [
m ans>> seed>> m (>>ans)
m ans>> failed? [
@ -184,14 +182,11 @@ TUPLE: peg-head rule-id involved-set eval-set ;
] if
] [
m ans>> seed>>
] if
] ; inline
] if ; inline
:: recall ( r p -- memo-entry )
[let* |
m [ p r rule-id memo ]
h [ p heads at ]
|
p r rule-id memo :> m
p heads at :> h
h [
m r rule-id h involved-set>> h rule-id>> suffix member? not and [
fail p memo-entry boa
@ -207,15 +202,12 @@ TUPLE: peg-head rule-id involved-set eval-set ;
] if
] [
m
] if
] ; inline
] if ; inline
:: apply-non-memo-rule ( r p -- ast )
[let* |
lr [ fail r rule-id f lrstack get left-recursion boa ]
m [ lr lrstack set lr p memo-entry boa dup p r rule-id set-memo ]
ans [ r eval-rule ]
|
fail r rule-id f lrstack get left-recursion boa :> lr
lr lrstack set lr p memo-entry boa dup p r rule-id set-memo :> m
r eval-rule :> ans
lrstack get next>> lrstack set
pos get m (>>pos)
lr head>> [
@ -226,8 +218,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
] [
ans m (>>ans)
ans
] if
] ; inline
] if ; inline
: apply-memo-rule ( r m -- ast )
[ ans>> ] [ pos>> ] bi pos set
@ -622,20 +613,17 @@ PRIVATE>
ERROR: parse-failed input word ;
SYNTAX: PEG:
(:)
[let | effect [ ] def [ ] word [ ] |
(:) :> effect :> def :> word
[
[
[let | compiled-def [ def call compile ] |
[
dup compiled-def compiled-parse
[ ast>> ] [ word parse-failed ] ?if
]
word swap effect define-declared
def call compile :> compiled-def
[
dup compiled-def compiled-parse
[ ast>> ] [ word parse-failed ] ?if
]
word swap effect define-declared
] with-compilation-unit
] over push-all
] ;
] over push-all ;
USING: vocabs vocabs.loader ;