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

Simplify combinator with joe's suggestion, unit test

db4
Doug Coleman 2010-08-29 15:24:55 -05:00
parent bd3fccfd4a
commit 1e9afc927f
2 changed files with 54 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/html/parser/analyzer/analyzer-tests.factor Normal file
View File

@ -0,0 +1,29 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: html.parser.analyzer math 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

41
extra/html/parser/analyzer/analyzer.factor
View File

@ -3,7 +3,7 @@
USING: accessors assocs combinators combinators.short-circuit USING: accessors assocs combinators combinators.short-circuit
fry html.parser http.client io kernel locals math sequences fry html.parser http.client io kernel locals math sequences
sets splitting unicode.case unicode.categories urls sets splitting unicode.case unicode.categories urls
urls.encoding ; urls.encoding shuffle ;
IN: html.parser.analyzer IN: html.parser.analyzer
: scrape-html ( url -- headers vector ) : scrape-html ( url -- headers vector )
@ -21,23 +21,32 @@ IN: html.parser.analyzer
: find-all ( seq quot -- alist ) : find-all ( seq quot -- alist )
[ <enum> >alist ] [ '[ second @ ] ] bi* filter ; inline [ <enum> >alist ] [ '[ second @ ] ] bi* filter ; inline
: loopn-index ( ... pred: ( ... n -- ... ? ) n -- ... ) : loopn-index ( n quot -- )
dup 0 > [ [ iota ] [ '[ @ not ] ] bi* find 2drop ; inline
[ swap call ] [ 1 - ] 2bi
[ loopn-index ] 2curry when
] [
2drop
] if ; inline recursive
: loopn ( ... pred: ( ... -- ... ? ) n -- ... ) : loopn ( n quot -- )
[ [ drop ] prepose ] dip loopn-index ; inline [ drop ] prepose loopn-index ; inline
:: find-nth ( n seq quot -- i/f elt/f ) ERROR: undefined-find-nth m n seq quot ;
0 t [
[ drop seq quot find-from ] dip 1 = [ : check-trivial-find ( m n seq quot -- m n seq quot )
over [ [ 1 + ] dip ] when pick 0 = [ undefined-find-nth ] when ; inline
] unless over >boolean
] n loopn-index ; 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 ) : find-first-name ( vector string -- i/f tag/f )
>lower '[ name>> _ = ] find ; inline >lower '[ name>> _ = ] find ; inline