Simplify combinator with joe's suggestion, unit test

diff --git a/extra/html/parser/analyzer/analyzer-tests.factor b/extra/html/parser/analyzer/analyzer-tests.factor
new file mode 100644 (file)
index 0000000..4d2378c
--- /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 8f92d78f57d97c58f9c000c6990bd757210d4275..c67a03cbfcd85cad0956a047661f302bc8284c84 100644 (file)
--- 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 )
    [ <enum> >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