sequences.extras: move some words here, add more words

locals-and-roots
Doug Coleman 2016-06-26 18:25:04 -07:00
parent ecd0bb350c
commit ec17b254e6
4 changed files with 67 additions and 53 deletions

View File

@ -227,3 +227,33 @@ IN: sequences.extras.tests
{ }
[ "test:" all-words [ name>> over prepend ] map-zip 2drop ] unit-test
{ 0 3 }
[ 1 { 3 5 7 9 11 } [ odd? ] find-nth ] unit-test
{ 2 7 }
[ 3 { 3 5 7 9 11 } [ odd? ] find-nth ] unit-test
{ 3 9 }
[ 3 1 { 3 5 7 9 11 } [ odd? ] find-nth-from ] unit-test
{ 4 11 }
[ 1 { 3 5 7 9 11 } [ odd? ] find-last-nth ] unit-test
{ 2 7 }
[ 3 { 3 5 7 9 11 } [ odd? ] find-last-nth ] unit-test
{ 0 3 }
[ 1 2 { 3 5 7 9 11 } [ odd? ] find-last-nth-from ] unit-test
[ 0 { 3 5 7 9 11 } [ odd? ] find-nth ]
[ undefined-find-nth? ] must-fail-with
[ 0 { 3 5 7 9 11 } [ odd? ] find-last-nth ]
[ undefined-find-nth? ] must-fail-with
{ { 1 1 2 1 } }
[ 3 { 1 1 2 1 } [ 2 = not ] head-nth ] unit-test

View File

@ -600,6 +600,41 @@ PRIVATE>
: map-find-last-index ( ... seq quot: ( ... elt index -- ... result/f ) -- ... result i elt )
[ find-last-index ] (map-find-index) ; inline
: loopn-index ( n quot -- )
[ iota ] [ $[ @ not ] ] bi* find 2drop ; inline
: loopn ( n quot -- )
[ drop ] prepose loopn-index ; inline
ERROR: undefined-find-nth m n seq quot ;
: check-trivial-find ( m n seq quot -- m n seq quot )
pick 0 = [ undefined-find-nth ] when ; inline
: find-nth-from ( m n seq quot -- i/f elt/f )
check-trivial-find [ f ] 3dip $[
drop _ _ find-from [ dup [ 1 + ] when ] dip over
] loopn [ dup [ 1 - ] when ] dip ; inline
: find-nth ( n seq quot -- i/f elt/f )
[ 0 ] 3dip find-nth-from ; inline
: find-last-nth-from ( m n seq quot -- i/f elt/f )
check-trivial-find [ f ] 3dip $[
drop _ _ find-last-from [ dup [ 1 - ] when ] dip over
] loopn [ dup [ 1 + ] when ] dip ; inline
: find-last-nth ( n seq quot -- i/f elt/f )
[ [ nip length 1 - ] [ ] 2bi ] dip find-last-nth-from ; inline
ERROR: head-nth-reached-end n seq quot ;
:: head-nth ( n seq quot -- seq' )
n seq quot find-nth drop [
[ seq ] dip 1 + head
] [
n seq quot head-nth-reached-end
] if* ; inline
:: (start-all) ( subseq seq increment -- indices )
0
[ [ subseq seq ] dip start* dup ]

View File

@ -3,31 +3,6 @@
USING: html.parser html.parser.analyzer kernel math sequences tools.test ;
IN: html.parser.analyzer.tests
{ 0 3 }
[ 1 { 3 5 7 9 11 } [ odd? ] find-nth ] unit-test
{ 2 7 }
[ 3 { 3 5 7 9 11 } [ odd? ] find-nth ] unit-test
{ 3 9 }
[ 3 1 { 3 5 7 9 11 } [ odd? ] find-nth-from ] unit-test
{ 4 11 }
[ 1 { 3 5 7 9 11 } [ odd? ] find-last-nth ] unit-test
{ 2 7 }
[ 3 { 3 5 7 9 11 } [ odd? ] find-last-nth ] unit-test
{ 0 3 }
[ 1 2 { 3 5 7 9 11 } [ odd? ] find-last-nth-from ] unit-test
[ 0 { 3 5 7 9 11 } [ odd? ] find-nth ]
[ undefined-find-nth? ] must-fail-with
[ 0 { 3 5 7 9 11 } [ odd? ] find-last-nth ]
[ undefined-find-nth? ] must-fail-with
{ V{
T{ tag f text f "foo" f }
}

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators combinators.short-circuit
fry html.parser http.client io kernel locals math math.statistics
sequences sets splitting unicode urls urls.encoding shuffle ;
sequences sequences.extras sets splitting unicode urls urls.encoding
shuffle ;
IN: html.parser.analyzer
: scrape-html ( url -- response vector )
@ -20,39 +21,12 @@ IN: html.parser.analyzer
: find-all ( seq quot -- alist )
[ <enum> >alist ] [ $[ second @ ] ] bi* filter ; inline
: loopn-index ( n quot -- )
[ iota ] [ $[ @ not ] ] bi* find 2drop ; inline
: loopn ( n quot -- )
[ drop ] prepose loopn-index ; inline
: html-class? ( tag string -- ? )
swap "class" attribute [ blank? ] split-when member? ;
: html-id? ( tag string -- ? )
swap "id" attribute = ;
ERROR: undefined-find-nth m n seq quot ;
: check-trivial-find ( m n seq quot -- m n seq quot )
pick 0 = [ undefined-find-nth ] when ; inline
: find-nth-from ( m n seq quot -- i/f elt/f )
check-trivial-find [ f ] 3dip $[
drop _ _ find-from [ dup [ 1 + ] when ] dip over
] loopn [ dup [ 1 - ] when ] dip ; inline
: find-nth ( n seq quot -- i/f elt/f )
[ 0 ] 3dip find-nth-from ; inline
: find-last-nth-from ( m n seq quot -- i/f elt/f )
check-trivial-find [ f ] 3dip $[
drop _ _ find-last-from [ dup [ 1 - ] when ] dip over
] loopn [ dup [ 1 + ] when ] dip ; inline
: find-last-nth ( n seq quot -- i/f elt/f )
[ [ nip length 1 - ] [ ] 2bi ] dip find-last-nth-from ; inline
: find-first-name ( vector string -- i/f tag/f )
>lower $[ name>> _ = ] find ; inline