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