Updates for parser-combinators

release
Slava Pestov 2007-12-02 15:55:44 -05:00
parent 12ff0614e6
commit 7cbf7ba719
1 changed files with 13 additions and 12 deletions

View File

@ -290,18 +290,19 @@ LAZY: <(+)> ( parser -- parser )
LAZY: surrounded-by ( parser start end -- parser' ) LAZY: surrounded-by ( parser start end -- parser' )
[ token ] 2apply swapd pack ; [ token ] 2apply swapd pack ;
: predicates>cond ( seq -- quot ) : exactly-n ( parser n -- parser' )
#! Takes an array of quotation predicates/objects and makes a cond swap <repetition> <and-parser> ;
#! Makes a predicate of each obj like so: [ dup obj = ]
#! Leaves quotations alone
#! The cond returns a boolean, t if one of the predicates matches
[
dup callable? [ [ = ] curry ] unless
[ dup ] swap compose [ drop t ] 2array
] map { [ t ] [ drop f ] } add [ cond ] curry ;
GENERIC: parser>predicate ( obj -- quot ) : at-most-n ( parser n -- parser' )
dup zero? [
2drop epsilon
] [
2dup exactly-n
-rot 1- at-most-n <|>
] if ;
M: satisfy-parser parser>predicate ( obj -- quot ) : at-least-n ( parser n -- parser' )
satisfy-parser-quot ; dupd exactly-n swap <*> <&> ;
: from-m-to-n ( parser m n -- parser' )
>r [ exactly-n ] 2keep r> swap - at-most-n <&> ;