Permalink
Browse files

Simplify combinator with joe's suggestion, unit test

  • Loading branch information...
1 parent c34eccf commit e5e036c604556779e86ca27ba4d8bf58c39ec794 @erg erg committed Aug 29, 2010
Showing with 56 additions and 18 deletions.
  1. +29 −0 extra/html/parser/analyzer/analyzer-tests.factor
  2. +27 −18 extra/html/parser/analyzer/analyzer.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
@@ -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

0 comments on commit e5e036c

Please sign in to comment.