Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

sequences.generalizations: add "nfind" and "nany?".

  • Loading branch information...
commit 4d49dcd03f771e0797eb1ea84a289a43b5d7f140 1 parent 3845c07
@mrjbq7 authored
View
8 basis/sequences/generalizations/generalizations-docs.factor
@@ -118,6 +118,14 @@ HELP: nall?
{ $values { "seqs..." { $snippet "n" } " sequences on the datastack" } { "quot" { $quotation "( element... - ? )" } } { "n" integer } { "?" boolean } }
{ $description "A generalization of " { $link all? } " that can be applied to any number of sequences." } ;
+HELP: nfind
+{ $values { "seqs..." { $snippet "n" } " sequences on the datastack" } { "quot" { $quotation "( element... - ? )" } } { "n" integer } { "i" integer } { "elts..." { $snippet "n" } " elements on the datastack" } }
+{ $description "A generalization of " { $link find } " that can be applied to any number of sequences." } ;
+
+HELP: nany?
+{ $values { "seqs..." { $snippet "n" } " sequences on the datastack" } { "quot" { $quotation "( element... - ? )" } } { "n" integer } { "?" boolean } }
+{ $description "A generalization of " { $link any? } " that can be applied to any number of sequences." } ;
+
ARTICLE: "sequences.generalizations" "Generalized sequence words"
"The " { $vocab-link "sequences.generalizations" } " vocabulary defines generalized versions of various sequence operations."
{ $subsections
View
10 basis/sequences/generalizations/generalizations-tests.factor
@@ -140,3 +140,13 @@ D4d$
{ t } [
{ 1 3 5 } { 2 4 6 } { 4 8 12 } [ + + odd? ] 3 nall?
] unit-test
+
+{ t } [
+ { 2 4 5 } { 4 6 7 } { 6 8 9 }
+ [ [ odd? ] tri@ and and ] 3 nany?
+] unit-test
+
+{ f } [
+ { 1 2 3 } { 4 5 6 } { 7 8 9 }
+ [ [ odd? ] tri@ and and ] 3 nany?
+] unit-test
View
20 basis/sequences/generalizations/generalizations.factor
@@ -124,3 +124,23 @@ MACRO: nmap-reduce ( map-quot reduce-quot n -- quot )
: nall? ( seqs... quot n -- ? )
(neach) all-integers? ; inline
+
+MACRO: finish-nfind ( n -- quot )
+ [ 1 + ] keep dup dup dup '[
+ _ npick
+ [ [ dup ] _ ndip _ nnth-unsafe ]
+ [ _ ndrop _ [ f ] times ]
+ if
+ ] ;
+
+: (nfind) ( seqs... quot n quot' -- i elts... )
+ over
+ [ '[ _ _ (neach) @ ] ] dip
+ [ '[ _ finish-nfind ] ] keep
+ nbi ; inline
+
+: nfind ( seqs... quot n -- i elts... )
+ [ find-integer ] (nfind) ; inline
+
+: nany? ( seqs... quot n -- ? )
+ [ nfind ] [ ndrop ] bi >boolean ; inline
Please sign in to comment.
Something went wrong with that request. Please try again.