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

Add declaration

db4
Slava Pestov 2008-08-22 18:09:38 -05:00
parent 2440fc1ceb
commit 3eb0476811
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/peg/peg.factor
View File

@ -4,7 +4,8 @@ USING: kernel sequences strings fry namespaces math assocs shuffle debugger io
vectors arrays math.parser math.order vectors combinators vectors arrays math.parser math.order vectors combinators
classes sets unicode.categories compiler.units parser classes sets unicode.categories compiler.units parser
words quotations effects memoize accessors locals effects splitting words quotations effects memoize accessors locals effects splitting
combinators.short-circuit combinators.short-circuit.smart ; combinators.short-circuit combinators.short-circuit.smart
generalizations ;
IN: peg IN: peg
USE: prettyprint USE: prettyprint
@ -144,15 +145,15 @@ TUPLE: peg-head rule-id involved-set eval-set ;
: setup-growth ( h p -- ) : setup-growth ( h p -- )
pos set dup involved-set>> clone >>eval-set drop ; pos set dup involved-set>> clone >>eval-set drop ;
: (grow-lr) ( h p r m -- ) : (grow-lr) ( h p r: ( -- result ) m -- )
>r >r [ setup-growth ] 2keep r> r> >r >r [ setup-growth ] 2keep r> r>
>r dup eval-rule r> swap >r dup eval-rule r> swap
dup pick stop-growth? [ dup pick stop-growth? [
4drop drop 5 ndrop
] [ ] [
over update-m over update-m
(grow-lr) (grow-lr)
] if ; inline ] if ; inline recursive
: grow-lr ( h p r m -- ast ) : grow-lr ( h p r m -- ast )
>r >r [ heads set-at ] 2keep r> r> >r >r [ heads set-at ] 2keep r> r>