! Copyright (C) 2005, 2009 Daniel Ehrenberg, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors circular combinators.short-circuit fry io
-kernel locals math math.order sequences sorting.functor
-sorting.slots unicode.categories ;
+USING: accessors circular combinators.short-circuit io kernel
+math math.order sequences sequences.parser sequences.private
+sorting.functor sorting.slots unicode ;
IN: sequences.parser
TUPLE: sequence-parser sequence n ;
:: with-sequence-parser ( sequence-parser quot -- seq/f )
sequence-parser n>> :> n
sequence-parser quot call [
- n sequence-parser (>>n) f
+ n sequence-parser n<< f
] unless* ; inline
: offset ( sequence-parser offset -- char/f )
: get+increment ( sequence-parser -- char/f )
[ current ] [ advance drop ] bi ; inline
-:: skip-until ( sequence-parser quot: ( obj -- ? ) -- )
+:: skip-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... )
sequence-parser current [
sequence-parser quot call
[ sequence-parser advance quot skip-until ] unless
: sequence-parse-end? ( sequence-parser -- ? ) current not ;
-: take-until ( sequence-parser quot: ( obj -- ? ) -- sequence/f )
+: take-until ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
over sequence-parse-end? [
2drop f
] [
[ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like
] if ; inline
-: take-while ( sequence-parser quot: ( obj -- ? ) -- sequence/f )
+: take-while ( ... sequence-parser quot: ( ... obj -- ... ? ) -- ... sequence/f )
[ not ] compose take-until ; inline
: <safe-slice> ( from to seq -- slice/f )
3dup {
[ 2drop 0 < ]
- [ [ drop ] 2dip length > ]
+ [ nipd length > ]
[ drop > ]
- } 3|| [ 3drop f ] [ slice boa ] if ; inline
+ } 3|| [ 3drop f ] [ <slice-unsafe> ] if ; inline
:: take-sequence ( sequence-parser sequence -- obj/f )
sequence-parser [ n>> dup sequence length + ] [ sequence>> ] bi
sequence-parser [ growing length - 1 + ] change-n drop
! sequence-parser advance drop
] [
- saved sequence-parser (>>n)
+ saved sequence-parser n<<
f
] if ;