From 5ccfb83a4d2a83bddd6f9b0e71c79b9e93849616 Mon Sep 17 00:00:00 2001
From: lorynj <lorynj@gmail.com>
Date: Sun, 5 May 2013 10:08:48 +1000
Subject: [PATCH] when-negative / when-positive
Convenience combinators to encapsulate testing numbers for being negative or positive, followed by call to a true quotation.
Signed-off-by: lorynj <lorynj@gmail.com>
---
.../math/combinators/combinators-docs.factor | 24 +++++++++++++++++++
.../math/combinators/combinators-tests.factor | 13 ++++++++++
extra/math/combinators/combinators.factor | 10 ++++++++
3 files changed, 47 insertions(+)
create mode 100644 extra/math/combinators/combinators-docs.factor
create mode 100644 extra/math/combinators/combinators-tests.factor
create mode 100644 extra/math/combinators/combinators.factor
diff --git a/extra/math/combinators/combinators-docs.factor b/extra/math/combinators/combinators-docs.factor
new file mode 100644
index 0000000000..494e9fe249
--- /dev/null
+++ b/extra/math/combinators/combinators-docs.factor
@@ -0,0 +1,24 @@
+USING: arrays help.markup help.syntax math
+sequences.private vectors strings kernel math.order layouts
+quotations generic.single ;
+IN: math.combinators
+
+HELP: when-negative
+{ $values
+ { "n" "an integer" } { "true" "a quotation" } { "m" "an integer" } }
+{ $description "When the n value is negative, calls the true quotation. The n value is passed to the quotation." }
+{ $examples "The following two lines are equivalent."
+ { $example "-1 [ 1 + ] when-negative\n-1 dup 0 < [ 1 + ] when"
+ "0\n0"
+ }
+} ;
+
+HELP: when-positive
+{ $values
+ { "n" "an integer" } { "true" "a quotation" } { "m" "an integer" } }
+{ $description "When the n value is positive, calls the true quotation. The n value is passed to the quotation." }
+{ $examples "The following two lines are equivalent."
+ { $example "1 [ 1 + ] when-positive\n1 dup 0 > [ 1 + ] when"
+ "2\n2"
+ }
+} ;
\ No newline at end of file
diff --git a/extra/math/combinators/combinators-tests.factor b/extra/math/combinators/combinators-tests.factor
new file mode 100644
index 0000000000..430c07b765
--- /dev/null
+++ b/extra/math/combinators/combinators-tests.factor
@@ -0,0 +1,13 @@
+! Copyright (C) 2013 Loryn Jenkins.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.combinators
+ tools.test ;
+IN: math.combinators.tests
+
+[ 0 ] [ -3 [ drop 0 ] when-negative ] unit-test
+[ -2 ] [ -3 [ 1 + ] when-negative ] unit-test
+[ 2 ] [ 2 [ 0 ] when-negative ] unit-test
+
+[ 0 ] [ 3 [ drop 0 ] when-positive ] unit-test
+[ 4 ] [ 3 [ 1 + ] when-positive ] unit-test
+[ -2 ] [ -2 [ 0 ] when-positive ] unit-test
\ No newline at end of file
diff --git a/extra/math/combinators/combinators.factor b/extra/math/combinators/combinators.factor
new file mode 100644
index 0000000000..bad04f5917
--- /dev/null
+++ b/extra/math/combinators/combinators.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2013 Loryn Jenkins.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math fry ;
+IN: math.combinators
+
+: when-negative ( ..n true: ( ..a -- ..b ) -- ..m )
+ '[ _ dup 0 < [ @ ] when ] call ; inline
+
+: when-positive ( ..n true: ( ..a -- ..b ) -- ..m )
+ '[ _ dup 0 > [ @ ] when ] call ; inline
\ No newline at end of file