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

peg: reuse code in compile-parsers-quots.

clean-linux-x86-32
John Benediktsson 2019-09-26 08:56:42 -07:00
parent e643afa168
commit f2e4a36c2c
1 changed files with 17 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
basis/peg/peg.factor
View File

@ -50,6 +50,9 @@ SYMBOL: error-stack
SYMBOL: ignore SYMBOL: ignore
: ignore? ( obj -- ? )
ignore = ;
: packrat ( id -- cache ) : packrat ( id -- cache )
! The packrat cache is a mapping of parser-id->cache. ! The packrat cache is a mapping of parser-id->cache.
! For each parser it maps to a cache holding a mapping ! For each parser it maps to a cache holding a mapping
@ -268,6 +271,7 @@ GENERIC: (compile) ( peg -- quot )
: define-parser-word ( parser word -- ) : define-parser-word ( parser word -- )
! Return the body of the word that is the compiled version ! Return the body of the word that is the compiled version
! of the parser. ! of the parser.
2dup swap peg>> (compile) ( -- result ) define-declared 2dup swap peg>> (compile) ( -- result ) define-declared
swap id>> "peg-id" set-word-prop ; swap id>> "peg-id" set-word-prop ;
@ -285,7 +289,11 @@ GENERIC: (compile) ( peg -- quot )
] if* ; ] if* ;
: compile-parser-quot ( parser -- quot ) : compile-parser-quot ( parser -- quot )
compile-parser [ execute-parser ] curry ; compile-parser '[ _ execute-parser ] ;
: compile-parsers-quots ( parsers -- quots )
[ compile-parser-quot ] map dup rest-slice
[ '[ @ merge-errors ] ] map! drop ;
SYMBOL: delayed SYMBOL: delayed
@ -373,12 +381,8 @@ TUPLE: seq-parser parsers ;
: calc-seq-result ( prev-result current-result -- next-result ) : calc-seq-result ( prev-result current-result -- next-result )
[ [
[ remaining>> swap remaining<< ] 2keep [ remaining>> >>remaining ] [ ast>> ] bi
ast>> dup ignore = [ dup ignore? [ drop ] [ over ast>> push ] if
drop
] [
swap [ ast>> push ] keep
] if
] [ ] [
drop f drop f
] if* ; ] if* ;
@ -387,31 +391,21 @@ TUPLE: seq-parser parsers ;
'[ @ calc-seq-result ] [ f ] if* ; inline '[ @ calc-seq-result ] [ f ] if* ; inline
M: seq-parser (compile) M: seq-parser (compile)
[ parsers>> compile-parsers-quots
[ input-slice V{ } clone <parse-result> ] % [ '[ _ parse-seq-element ] ] map
[ '[ input-slice V{ } clone <parse-result> _ 1&& ] ;
parsers>> unclip compile-parser-quot [ parse-seq-element ] curry ,
[ compile-parser-quot [ merge-errors ] compose [ parse-seq-element ] curry , ] each
] { } make , \ 1&& ,
] [ ] make ;
TUPLE: choice-parser parsers ; TUPLE: choice-parser parsers ;
M: choice-parser (compile) M: choice-parser (compile)
[ parsers>> compile-parsers-quots '[ _ 0|| ] ;
[
parsers>> [ compile-parser-quot ] map
unclip , [ [ merge-errors ] compose , ] each
] { } make , \ 0|| ,
] [ ] make ;
TUPLE: repeat0-parser parser ; TUPLE: repeat0-parser parser ;
: (repeat) ( quot: ( -- result ) result -- result ) : (repeat) ( quot: ( -- result ) result -- result )
over call [ over call [
[ remaining>> swap remaining<< ] 2keep [ remaining>> >>remaining ] [ ast>> ] bi
ast>> swap [ ast>> push ] keep over ast>> push (repeat)
(repeat)
] [ ] [
nip nip
] if* ; inline recursive ] if* ; inline recursive