From 1e9afc927f36fa429619042b8bdfc55c4c55aebb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 29 Aug 2010 15:24:55 -0500 Subject: [PATCH] Simplify combinator with joe's suggestion, unit test --- .../parser/analyzer/analyzer-tests.factor | 29 ++++++++++++ extra/html/parser/analyzer/analyzer.factor | 45 +++++++++++-------- 2 files changed, 56 insertions(+), 18 deletions(-) create mode 100644 extra/html/parser/analyzer/analyzer-tests.factor diff --git a/extra/html/parser/analyzer/analyzer-tests.factor b/extra/html/parser/analyzer/analyzer-tests.factor new file mode 100644 index 0000000000..4d2378c7ea --- /dev/null +++ b/extra/html/parser/analyzer/analyzer-tests.factor @@ -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 diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 8f92d78f57..c67a03cbfc 100644 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,7 +3,7 @@ USING: accessors assocs combinators combinators.short-circuit fry html.parser http.client io kernel locals math sequences sets splitting unicode.case unicode.categories urls -urls.encoding ; +urls.encoding shuffle ; IN: html.parser.analyzer : scrape-html ( url -- headers vector ) @@ -21,23 +21,32 @@ IN: html.parser.analyzer : find-all ( seq quot -- alist ) [ >alist ] [ '[ second @ ] ] bi* filter ; inline -: loopn-index ( ... pred: ( ... n -- ... ? ) n -- ... ) - dup 0 > [ - [ swap call ] [ 1 - ] 2bi - [ loopn-index ] 2curry when - ] [ - 2drop - ] if ; inline recursive - -: loopn ( ... pred: ( ... -- ... ? ) n -- ... ) - [ [ drop ] prepose ] dip loopn-index ; inline - -:: find-nth ( n seq quot -- i/f elt/f ) - 0 t [ - [ drop seq quot find-from ] dip 1 = [ - over [ [ 1 + ] dip ] when - ] unless over >boolean - ] n loopn-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 : find-first-name ( vector string -- i/f tag/f ) >lower '[ name>> _ = ] find ; inline -- 2.34.1