combinators.extras: Add more documentation

Add quad-curry variants
Add fries
Fix some stack effects

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 908cd4ca05c94c01e9fd60452820cf318640ee41..fe0f591b6f3da63d5181f093cf51abfbf3264966 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -284,18 +284,18 @@ HELP: call
 
 HELP: keep
 { $values { "x" object } { "quot" { $quotation ( ..a x -- ..b ) } } }
-{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }
+{ $description "Calls a quotation with a value on the stack, restoring the value when the quotation returns." }
 { $examples
     { $example "USING: arrays kernel prettyprint ;" "2 \"greetings\" [ <array> ] keep 2array ." "{ { \"greetings\" \"greetings\" } \"greetings\" }" }
 } ;
 
 HELP: 2keep
 { $values { "x" object } { "y" object } { "quot" { $quotation ( ..a x y -- ..b ) } } }
-{ $description "Call a quotation with two values on the stack, restoring the values when the quotation returns." } ;
+{ $description "Calls a quotation with two values on the stack, restoring the values when the quotation returns." } ;
 
 HELP: 3keep
 { $values { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( ..a x y z -- ..b ) } } }
-{ $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ;
+{ $description "Calls a quotation with three values on the stack, restoring the values when the quotation returns." } ;
 
 HELP: bi
 { $values { "x" object } { "p" { $quotation ( ..a x -- ..b ) } } { "q" { $quotation ( ..c x -- ..d ) } } }

diff --git a/extra/combinators/extras/extras-docs.factor b/extra/combinators/extras/extras-docs.factor
index 11d26e3b786a404973c63a5cf78ed7c44a6facb0..8991ea62d8c8d6f81321f1ed772914c61d5086e5 100644 (file)
--- a/extra/combinators/extras/extras-docs.factor
+++ b/extra/combinators/extras/extras-docs.factor
@@ -1,7 +1,35 @@
-USING: combinators help.markup help.syntax ;
+USING: combinators help.markup help.syntax kernel quotations ;
 
 IN: combinators.extras
 
+HELP: once
+{ $values { "quot" "a quotation" } }
+{ $description "Calls a quotation one time." } ;
+
+HELP: twice
+{ $values { "quot" "a quotation" } }
+{ $description "Calls a quotation two times." }
+{ $examples
+    "The following two lines are equivalent:"
+    { $code "[ q ] twice" "q q" }
+} ;
+
+HELP: thrice
+{ $values { "quot" "a quotation" } }
+{ $description "Calls a quotation three times." }
+{ $examples
+    "The following two lines are equivalent:"
+    { $code "[ q ] thrice" "q q q" }
+} ;
+
+HELP: forever
+{ $values { "quot" "a quotation" } }
+{ $description "Calls a quotation in an endless loop." }
+{ $examples
+    "The following two lines are equivalent:"
+    { $code "[ q ] forever" "[ t ] [ q ] while" }
+} ;
+
 HELP: cond-case
 { $values { "assoc" "a sequence of quotation pairs and an optional quotation" } }
 { $description
@@ -20,3 +48,235 @@ HELP: cond-case
         "zero"
     }
 } ;
+
+HELP: cleave-array
+{ $values { "quots" "a sequence of quotations" } }
+{ $description "Like " { $link cleave } ", but wraps the output in an array." } ;
+
+HELP: 4bi
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( w x y z -- ... ) } } { "q" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to the four input values, then applies " { $snippet "q" } " to the four input values." } ;
+
+HELP: 4tri
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( w x y z -- ... ) } } { "q" { $quotation ( w x y z -- ... ) } } { "r" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to the four input values, then applies " { $snippet "q" } " to the four input values, and finally applies " { $snippet "r" } " to the four input values." } ;
+
+HELP: quad
+{ $values { "x" object } { "p" { $quotation ( x -- ... ) } } { "q" { $quotation ( x -- ... ) } } { "r" { $quotation ( x -- ... ) } } { "s" { $quotation ( x -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to " { $snippet "x" } ", then applies " { $snippet "q" } " to " { $snippet "x" } ", then applies " { $snippet "r" } " to " { $snippet "x" } ", and finally applies " { $snippet "s" } " to " { $snippet "x" } "." } ;
+
+HELP: 2quad
+{ $values { "x" object } { "y" object } { "p" { $quotation ( x y -- ... ) } } { "q" { $quotation ( x y -- ... ) } } { "r" { $quotation ( x y -- ... ) } } { "s" { $quotation ( x y -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values, then applies " { $snippet "r" } " to the two input values, and finally applies " { $snippet "s" } " to the two input values." } ;
+
+HELP: 3quad
+{ $values { "x" object } { "y" object } { "z" object } { "p" { $quotation ( x y z -- ... ) } } { "q" { $quotation ( x y z -- ... ) } } { "r" { $quotation ( x y z -- ... ) } } { "s" { $quotation ( x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to the three input values, then applies " { $snippet "q" } " to the three input values, then applies " { $snippet "r" } " to the three input values, and finally applies " { $snippet "s" } " to the three input values." } ;
+
+HELP: 4quad
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( w x y z -- ... ) } } { "q" { $quotation ( w x y z -- ... ) } } { "r" { $quotation ( w x y z -- ... ) } } { "s" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to the four input values, then applies " { $snippet "q" } " to the four input values, then applies " { $snippet "r" } " to the four input values, and finally applies " { $snippet "s" } " to the four input values." } ;
+
+HELP: 3bi*
+{ $values { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( u v w -- ... ) } } { "q" { $quotation ( x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", then applies " { $snippet "q" } " to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4bi*
+{ $values { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( s t u v -- ... ) } } { "q" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to " { $snippet "s" } ", " { $snippet "t" } ", " { $snippet "u" } " and " { $snippet "v" } ", then applies " { $snippet "q" } " to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 3tri*
+{ $values { "o" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( o s t -- ... ) } } { "q" { $quotation ( u v w -- ... ) } } { "r" { $quotation ( x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } to { $snippet "o" } ", " { $snippet "s" } " and " { $snippet "t" } ", then applies " { $snippet "q" } " to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", and finally applies " { $snippet "r" } " to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4tri*
+{ $values { "l" object } { "m" object } { "n" object } { "o" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( l m n o -- ... ) } } { "q" { $quotation ( s t u v -- ... ) } } { "r" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies" { $snippet "p" } " to " { $snippet "l" } ", " { $snippet "m" } ", " { $snippet "n" } " and " { $snippet "o" } ", then applies q to " { $snippet "s" } ", " { $snippet "t" } ", " { $snippet "u" } ", " { $snippet "v" } ", and finally applies " { $snippet "r" } " to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: quad*
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( x -- ... ) } } { "q" { $quotation ( x -- ... ) } } { "r" { $quotation ( x -- ... ) } } { "s" { $quotation ( x -- ... ) } } }
+{ $description "Applies" { $snippet "p" } " to " { $snippet "w" } ", then applies " { $snippet "q" } " to " { $snippet "x" } ", then applies " { $snippet "r" } " to " { $snippet "y" } ", and finally applies " { $snippet "s" } " to " { $snippet "z" } "." } ;
+
+HELP: 2quad*
+{ $values { "o" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( s t  -- ... ) } } { "q" { $quotation ( u v -- ... ) } } { "r" { $quotation ( w x -- ... ) } } { "s" { $quotation ( y z -- ... ) } } }
+{ $description "Applies" { $snippet "p" } " to " { $snippet "s" } " and " { $snippet "t" } ", then applies " { $snippet "q" } " to " { $snippet "u" } " and " { $snippet "v" } ", then applies" { $snippet "r" } " to " { $snippet "w" } " and " { $snippet "x" } ", and finally applies " { $snippet "s" } " to " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 3quad*
+{ $values { "k" object } { "l" object } { "m" object } { "n" object } { "o" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( o p q  -- ... ) } } { "q" { $quotation ( r s t -- ... ) } } { "r" { $quotation ( u v w -- ... ) } } { "s" { $quotation ( x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to " { $snippet "k" } ", " { $snippet "l" } " and " { $snippet "m" } ", then applies " { $snippet "q" } " to " { $snippet "n" } ", " { $snippet "o" } " and " { $snippet "t" } ", then applies " { $snippet "r" } " to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", and finally applies " { $snippet "s" } " to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4quad*
+{ $values { "g" object } { "h" object } { "i" object } { "j" object } { "k" object } { "l" object } { "m" object } { "n" object } { "o" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( k l m n  -- ... ) } } { "q" { $quotation ( o p q r -- ... ) } } { "r" { $quotation ( s t u v -- ... ) } } { "s" { $quotation ( w x y z -- ... ) } } }
+{ $description "Applies " { $snippet "p" } " to " { $snippet "g" } ", " { $snippet "h" } ", " { $snippet "i" } " and " { $snippet "j" } ", then applies " { $snippet "q" } " to " { $snippet "k" } ", " { $snippet "l" } ", " { $snippet "m" } " and " { $snippet "n" } ", then applies " { $snippet "r" } " to " { $snippet "o" } ", " { $snippet "t" } ", " { $snippet "u" } " and " { $snippet "v" } ", and finally applies " { $snippet "s" } " to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 3bi@
+{ $values { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 obj3 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", and then to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4bi@
+{ $values { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj 2 obj3 obj4 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "s" } ", " { $snippet "t" } ", " { $snippet "u" } " and " { $snippet "v" } ", and then to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 3tri@
+{ $values { "r" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 obj3  -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "r" } ", " { $snippet "s" } " and " { $snippet "t" } ", then to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", and then to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4tri@
+{ $values { "o" object } { "p" object } { "q" object } { "r" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 obj3 obj4 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "o" } ", " { $snippet "p" } ", " { $snippet "q" } ", " { $snippet "r" } ", then to " { $snippet "s" } ", " { $snippet "t" } ", " { $snippet "u" } " and " { $snippet "v" } ", and finally to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: quad@
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "w" } ", then to " { $snippet "x" } ", then to " { $snippet "y" } ", and finally to " { $snippet "z" } "." } ;
+
+HELP: 2quad@
+{ $values { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "s" } " and " { $snippet "t" } ", then to " { $snippet "u" } " and " { $snippet "v" } ", then to " { $snippet "w" } " and " { $snippet "x" } ", and finally to " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 3quad@
+{ $values { "o" object } { "p" object } { "q" object } { "r" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 obj3 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "o" } ", " { $snippet "p" } " and " { $snippet "q" } ", then to " { $snippet "r" } ", " { $snippet "s" } " and " { $snippet "t" } ", then to " { $snippet "u" } ", " { $snippet "v" } " and " { $snippet "w" } ", and finally to " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: 4quad@
+{ $values { "k" object } { "l" object } { "m" object } { "n" object } { "o" object } { "p" object } { "q" object } { "r" object } { "s" object } { "t" object } { "u" object } { "v" object } { "w" object } { "x" object } { "y" object } { "z" object } { "quot" { $quotation ( obj1 obj2 obj3 obj4 -- ... ) } } }
+{ $description "Applies the quotation to " { $snippet "k" } ", " { $snippet "l" } ", " { $snippet "m" } " and " { $snippet "n" } ", then to " { $snippet "o" } ", " { $snippet "p" } ", " { $snippet "q" } " and " { $snippet "r" } ", then to " { $snippet "s" } ", " { $snippet "t" } ", " { $snippet "u" } " and " { $snippet "v" } ", and finally to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: quad-curry
+{ $values { "x" object } { "p" { $quotation ( x -- ... ) } } { "q" { $quotation ( x -- ... ) } } { "r" { $quotation ( x -- ... ) } } { "s" { $quotation ( x -- ... ) } } { "p'" { $snippet "[ x p ] " } } { "q'" { $snippet "[ x q ] " } } { "r'" { $snippet "[ x r ] " } } { "s'" { $snippet "[ x s ] " } } }
+{ $description "Partially applies " { $snippet "p" } ", " { $snippet "q" } ", " { $snippet "r" } " and " { $snippet "s" } " to " { $snippet "x" } "." } ;
+
+HELP: quad-curry*
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "p" { $quotation ( x -- ... ) } } { "q" { $quotation ( x -- ... ) } } { "r" { $quotation ( x -- ... ) } } { "s" { $quotation ( x -- ... ) } } { "p'" { $snippet "[ w p ] " } } { "q'" { $snippet "[ x q ] " } } { "r'" { $snippet "[ y r ] " } } { "s'" { $snippet "[ z s ] " } } }
+{ $description "Partially applies " { $snippet "p" } " to " { $snippet "w" } ", " { $snippet "q" } " to " { $snippet "x" } ", " { $snippet "r" } " to " { $snippet "y" } ", and " { $snippet "s" } " to " { $snippet "z" } "." } ;
+
+HELP: quad-curry@
+{ $values { "w" object } { "x" object } { "y" object } { "z" object } { "q" { $quotation ( x -- ... ) } } { "p'" { $snippet "[ w q ] " } } { "q'" { $snippet "[ x q ] " } } { "r'" { $snippet "[ y q ] " } } { "s'" { $snippet "[ z q ] " } } }
+{ $description "Partially applies" { $snippet "q" } " to " { $snippet "w" } ", " { $snippet "x" } ", " { $snippet "y" } " and " { $snippet "z" } "." } ;
+
+HELP: smart-plox
+{ $values { "true" { $quotation ( ... -- x ) } } }
+{ $description "Applies the quotation if none of the values consumed by the quotation are " { $link f } ", otherwise puts " { $link f } "on the stack." }
+;
+
+HELP: loop1
+{ $values { "quot" { $quotation ( ..a -- ..a obj ? ) } } { "obj" object } }
+{ $description "Similar to " { $link loop } ". Calls the the quotation repeatedly until it outputs " { $link f } ". While it does so, discards " { $snippet "obj" } ". When the loop finishes, leaves" { $snippet "obj" } "on the stack." } ;
+
+HELP: keep-1up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with a value on the stack, restoring the value under the topmost item on the stack." } ;
+
+HELP: keep-2up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with a value on the stack, restoring the value under the two topmost items on the stack." } ;
+
+HELP: keep-3up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with a value on the stack, restoring the value under the three topmost items on the stack." } ;
+
+HELP: 2keep-1up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with two values on the stack, restoring the values under the topmost item on the stack." } ;
+
+HELP: 2keep-2up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with two values on the stack, restoring the values under the two topmost items on the stack." } ;
+
+HELP: 2keep-3up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with two values on the stack, restoring the values under the three topmost items on the stack." } ;
+
+HELP: 3keep-1up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with three values on the stack, restoring the values under the topmost item on the stack." } ;
+
+HELP: 3keep-2up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with three values on the stack, restoring the values under the two topmost items on the stack." } ;
+
+HELP: 3keep-3up
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with three values on the stack, restoring the values under the three topmost items on the stack." } ;
+
+HELP: dip-1up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o ) } } { "o" object } }
+{ $description "Like " { $link dip } ", but moves the last value left on the stack by the quotation to the top of the stack." } ;
+
+HELP: dip-2up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o1 o2 ) } } { "o1" object } { "o2" object } }
+{ $description "Like " { $link dip } ", but moves the last two values left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 2dip-1up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o ) } } { "o" object } }
+{ $description "Like " { $link 2dip } ", but moves the last value left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 2dip-2up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o1 o2 ) } } { "o1" object } { "o2" object } }
+{ $description "Like " { $link 2dip } ", but moves the last two values left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 3dip-1up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o ) } } { "o" object } }
+{ $description "Like " { $link 3dip } ", but moves the last value left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 3dip-2up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o1 o2 ) } } { "o1" object } { "o2" object } }
+{ $description "Like " { $link 3dip } ", but moves the last two values left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 3dip-3up
+{ $values { "d" object } { "quot" { $quotation ( ..a -- ..b o1 o2 ) } } { "o1" object } { "o2" object } }
+{ $description "Like " { $link 3dip } ", but moves the last three values left on the stack by the quotation to the top of the stack." } ;
+
+HELP: 2craft-1up
+{ $values { "quot1" { $quotation ( ..a -- ..b o1 ) } } { "quot2" { $quotation ( ..b -- ..c o2 ) } } { "o1" object } { "o2" object } }
+{ $description "Applies " { $snippet "quot1" } "to the values on the stack and saves the last value left by the quotation on the stack. Then applies " { $snippet "quot2" } "to the rest of the values left on the stack by " { $snippet "quot1" } " and saves the last value left by the quotation on the stack. Finally the word puts the saved values on the stack." } ;
+
+HELP: 3craft-1up
+{ $values { "quot1" { $quotation ( ..a -- ..b o1 ) } } { "quot2" { $quotation ( ..b -- ..c o2 ) } } { "quot3" { $quotation ( ..c -- ..d o1 ) } } { "o1" object } { "o2" object } { "o3" object } }
+{ $description "A version of " { $link 2craft-1up } "that crafts 3 values." } ;
+
+HELP: 4craft-1up
+{ $values { "quot1" { $quotation ( ..a -- ..b o1 ) } } { "quot2" { $quotation ( ..b -- ..c o2 ) } } { "quot3" { $quotation ( ..c -- ..d o1 ) } } { "quot4" { $quotation ( ..d -- ..e o1 ) } } { "o1" object } { "o2" object } { "o3" object } { "o4" object } }
+{ $description "A version of " { $link 2craft-1up } "that crafts 4 values." } ;
+
+HELP: 3and
+{ $values { "a" "a generalized boolean" } { "b" "a generalized boolean" } { "c" "a generalized boolean" } }
+{ $description "Like " { $link and } ", but takes 3 values." } ;
+
+HELP: 4and
+{ $values { "a" "a generalized boolean" } { "b" "a generalized boolean" } { "c" "a generalized boolean" } { "d" "a generalized boolean" } }
+{ $description "Like " { $link and } ", but takes 4 values." } ;
+
+HELP: 3or
+{ $values { "a" "a generalized boolean" } { "b" "a generalized boolean" } { "c" "a generalized boolean" } }
+{ $description "Like " { $link or } ", but takes 3 values." } ;
+
+HELP: 4or
+{ $values { "a" "a generalized boolean" } { "b" "a generalized boolean" } { "c" "a generalized boolean" } { "d" "a generalized boolean" } }
+{ $description "Like " { $link or } ", but takes 4 values." } ;
+
+HELP: keep-under
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with a value on the stack, restoring the value below the outputs when the quotation returns." } ;
+
+HELP: 2keep-under
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with two values on the stack, restoring the values below the outputs when the quotation returns." } ;
+
+HELP: 3keep-under
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with three values on the stack, restoring the values below the outputs when the quotation returns." } ;
+
+HELP: 4keep-under
+{ $values { "quot" quotation } }
+{ $description "Calls a quotation with four values on the stack, restoring the values below the outputs when the quotation returns." } ;
+
+ARTICLE: "combinators.extras" "Extra combinators"
+"Call a quotation one, two or three times:" { $subsections once twice thrice }
+"Endless loops:" { $subsections forever }
+"An easier " { $link cond } " combinator:" { $subsections cond-case }
+"Cleave into an array:" { $subsections cleave-array }
+"More dataflow combinators:" { $subsections 4bi 3bi* 4bi* 3bi@ 4bi@ } { $subsections 4tri 3tri* 4tri* 3tri@ 4tri@ } { $subsections quad 2quad 3quad 4quad quad* 2quad* 3quad* 4quad* quad@ 2quad@ 3quad@ 4quad@ } { $subsections quad-curry quad-curry* quad-curry@ }
+"Stack permuting versions of " { $link keep } " and " { $link dip } ":" { $subsections keep-1up keep-2up keep-3up 2keep-1up 2keep-2up 2keep-3up 3keep-1up 3keep-2up 3keep-3up } { $subsections keep-under 2keep-under 3keep-under 4keep-under } { $subsections dip-1up dip-2up 2dip-1up 2dip-2up 3dip-1up 3dip-2up 3dip-3up } { $subsections 2craft-1up 3craft-1up 4craft-1up }
+"3- and 4-element versions of " { $link and } " and " { $link or } ":" { $subsections 3and 4and 3or 4or } ;
+
+ABOUT: "combinators.extras"

diff --git a/extra/combinators/extras/extras.factor b/extra/combinators/extras/extras.factor
index 9bac7f69b2a456b05c5539fc25423e8255168f44..eaf53138f0666fe54d81a58a077100fdc32a82b2 100644 (file)
--- a/extra/combinators/extras/extras.factor
+++ b/extra/combinators/extras/extras.factor
@@ -1,29 +1,32 @@
 ! Copyright (C) 2013 Doug Coleman, John Benediktsson.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: arrays assocs combinators combinators.smart
-generalizations graphs.private kernel math math.order namespaces
-quotations sequences sequences.generalizations sequences.private
-sets shuffle stack-checker.transforms system words ;
+generalizations graphs.private kernel kernel.private math
+math.order namespaces quotations sequences
+sequences.generalizations sequences.private sets shuffle
+stack-checker.transforms system words ;
 IN: combinators.extras
 
+<PRIVATE
 : callk ( ..a quot: ( ..a -- ..b ) -- ..b quot )
     dup [ call ] dip ; inline
+PRIVATE>
 
 : once ( quot -- ) call ; inline
 : twice ( quot -- ) callk call ; inline
 : thrice ( quot -- ) callk callk call ; inline
-: forever ( quot -- ) [ t ] compose loop ; inline
+: forever ( quot -- ) '[ @ t ] loop ; inline
 
 MACRO: cond-case ( assoc -- quot )
     [
         dup callable? not [
-            [ first [ dup ] prepose ]
-            [ second [ drop ] prepose ] bi 2array
+            [ first '[ dup @ ] ]
+            [ second '[ drop @ ] ] bi 2array
         ] when
-    ] map [ cond ] curry ;
+    ] map '[ _ cond ] ;
 
 MACRO: cleave-array ( quots -- quot )
-    [ '[ _ cleave ] ] [ length '[ _ narray ] ] bi compose ;
+    dup length '[ _ cleave _ narray ] ;
 
 : 4bi ( w x y z  p q -- )
     [ 4keep ] dip call ; inline
@@ -49,22 +52,22 @@ MACRO: cleave-array ( quots -- quot )
 : 4bi* ( s t u v  w x y z  p q -- )
     [ 4dip ] dip call ; inline
 
-: 3tri* ( r s t  u v w  x y z  p q r -- )
+: 3tri* ( o s t  u v w  x y z  p q r -- )
     [ 6 ndip ] 2dip [ 4dip ] dip call ; inline
 
-: 4tri* ( o p q r  s t u v  w x y z  p q r -- )
+: 4tri* ( l m n o  s t u v  w x y z  p q r -- )
     [ 8 ndip ] 2dip [ 4dip ] dip call ; inline
 
 : quad* ( w  x  y  z  p q r s -- )
     [ [ [ 3dip ] dip 2dip ] dip dip ] dip call ; inline
 
-: 2quad* ( s t  u v  w x  y z  p q r s -- )
+: 2quad* ( o t  u v  w x  y z  p q r s -- )
     [ [ [ 6 ndip ] dip 4dip ] dip 2dip ] dip call ; inline
 
-: 3quad* ( o p q  r s t  u v w  x y z  p q r s -- )
+: 3quad* ( k l m  n o t  u v w  x y z  p q r s -- )
     [ [ [ 9 ndip ] dip 6 ndip ] dip 3dip ] dip call ; inline
 
-: 4quad* ( k l m n  o p q r  s t u v  w x y z  p q r s -- )
+: 4quad* ( g h i j  k l m n  o t u v  w x y z  p q r s -- )
     [ [ [ 12 ndip ] dip 8 ndip ] dip 4dip ] dip call ; inline
 
 : 3bi@ ( u v w  x y z  quot -- ) dup 3bi* ; inline
@@ -89,7 +92,16 @@ MACRO: cleave-array ( quots -- quot )
 : 4quad@ ( k l m n  o p q r  s t u v  w x y z  quot -- )
     dup dup dup 4quad* ; inline
 
-MACRO: smart-plox ( true -- quot )
+: quad-curry ( x  p q r s -- p' q' r' s' )
+    [ currier ] quad@ quad ; inline
+
+: quad-curry* ( w x y z  p q r s -- p' q' r' s' )
+    [ currier ] quad@ quad* ; inline
+
+: quad-curry@ ( w x y z  q -- p' q' r' s' )
+    currier quad@ ; inline
+
+MACRO: smart-plox ( true: ( ... -- x ) -- quot )
     [ inputs [ 1 - [ and ] n*quot ] keep ] keep swap
     '[ _ _ [ _ ndrop f ] smart-if ] ;
 
@@ -102,12 +114,11 @@ MACRO: smart-plox ( true -- quot )
 : swap-when ( x y quot: ( x -- n ) quot: ( n n -- ? ) -- x' y' )
     '[ _ _ 2dup _ bi@ @ [ swap ] when ] call ; inline
 
+: 2falsify ( obj1 obj2 -- obj1/f obj2/f )
+    2dup and [ 2drop f f ] unless ; inline
 
-! ?1arg-result-falsify
-
-: 1falsify ( obj/f -- obj/f ) ; inline
-: 2falsify ( obj1 obj2 -- obj1/f obj2/f ) 2dup and [ 2drop f f ] unless ; inline
-: 3falsify ( obj1 obj2 obj3 -- obj1/f obj2/f obj3/f ) 3dup and and [ 3drop f f f ] unless ; inline
+: 3falsify ( obj1 obj2 obj3 -- obj1/f obj2/f obj3/f )
+    3dup and and [ 3drop f f f ] unless ; inline
 
 MACRO: n-and ( n -- quot )
     1 [-] [ and ] n*quot ;
@@ -134,8 +145,9 @@ MACRO:: n-falsify ( n -- quot )
     [ rot \ if* 3array [ ] append-as ] assoc-each ;
 
 : cond*>quot ( assoc -- quot )
-    [ dup pair? [ [ drop ] prepend [ t ] swap 2array ] unless ] map
-    reverse! [ no-cond ] swap alist>quot* ;
+    [
+        dup pair? [ [ drop ] prepend [ t ] swap 2array ] unless
+    ] map reverse! [ no-cond ] swap alist>quot* ;
 
 DEFER: cond*
 \ cond* [ cond*>quot ] 1 define-transform
@@ -150,12 +162,11 @@ MACRO: chain ( quots -- quot )
     <reversed> [ ] [ swap '[ [ @ @ ] [ f ] if* ] ] reduce ;
 
 : with-output-variable ( value variable quot -- value )
-    over [ get ] curry compose with-variable ; inline
+    over '[ @ _ get ] with-variable ; inline
 
 : loop1 ( ..a quot: ( ..a -- ..a obj ? ) -- ..a obj )
     [ call ] keep '[ drop _ loop1 ] when ; inline recursive
 
-
 : keep-1up ( quot -- quot ) keep 1 2 0 nrotated ; inline
 : keep-2up ( quot -- quot ) keep 2 3 0 nrotated ; inline
 : keep-3up ( quot -- quot ) keep 3 4 0 nrotated ; inline
@@ -169,23 +180,26 @@ MACRO: chain ( quots -- quot )
 : 3keep-3up ( quot -- quot ) 3keep 3 6 0 nrotated ; inline
 
 ! d is dummy, o is object to save notation space
-: dip-1up  ( ..a d quot: ( ..a -- ..b o d ) -- ..b d o )
+: dip-1up  ( ..a d quot: ( ..a -- ..b o ) -- ..b d o )
     dip swap ; inline
-: dip-2up  ( ..a d quot: ( ..a -- ..b o1 o2 d ) -- ..b d o1 o2 )
+
+: dip-2up  ( ..a d quot: ( ..a -- ..b o1 o2 ) -- ..b d o1 o2 )
     dip rot rot ; inline
 
-: 2dip-1up ( ..a d1 d2 quot: ( ..a -- ..b o d1 d2 ) -- ..b d1 d2 o )
+: 2dip-1up ( ..a d1 d2 quot: ( ..a -- ..b o ) -- ..b d1 d2 o )
     2dip rot ; inline
-: 2dip-2up ( ..a d1 d2 quot: ( ..a -- ..b o1 o2 d1 d2 ) -- ..b d1 d2 o1 o2 )
+
+: 2dip-2up ( ..a d1 d2 quot: ( ..a -- ..b o1 o2 ) -- ..b d1 d2 o1 o2 )
     2dip roll roll ; inline
 
-: 3dip-1up ( ..a d1 d2 d3 quot: ( ..a -- ..b o d1 d2 d3 ) -- ..b d1 d2 d3 o )
+: 3dip-1up ( ..a d1 d2 d3 quot: ( ..a -- ..b o ) -- ..b d1 d2 d3 o )
     3dip roll ; inline
-: 3dip-2up ( ..a d1 d2 d3 quot: ( ..a -- ..b o1 o2 d1 d2 d3 ) -- ..b d1 d2 d3 o1 o2 )
+
+: 3dip-2up ( ..a d1 d2 d3 quot: ( ..a -- ..b o1 o2 ) -- ..b d1 d2 d3 o1 o2 )
     3dip 2 5 0 nrotated ; inline
-: 3dip-3up ( ..a d1 d2 d3 quot: ( ..a -- ..b o1 o2 o3 d1 d2 d3 ) -- ..b d1 d2 d3 o1 o2 o3 )
-    3dip 3 6 0 nrotated ; inline
 
+: 3dip-3up ( ..a d1 d2 d3 quot: ( ..a -- ..b o1 o2 o3 ) -- ..b d1 d2 d3 o1 o2 o3 )
+    3dip 3 6 0 nrotated ; inline
 
 : 2craft-1up ( ..a quot1: ( ..a -- ..b o1 ) quot2: ( ..b -- ..c o2 ) -- ..c o1 o2 )
     [ call ] dip [ dip-1up ] call ; inline
@@ -194,7 +208,8 @@ MACRO: chain ( quots -- quot )
     [ call ] 2dip [ dip-1up ] dip [ 2dip-1up ] call ; inline
 
 : 4craft-1up ( ..a quot1: ( ..a -- ..b o1 ) quot2: ( ..b -- ..c o2 ) quot3: ( ..c -- ..d o3 ) quot4: ( ..d -- ..e o4 ) -- ..e o1 o2 o3 o4 )
-    [ call ] 3dip [ dip-1up ] 2dip [ 2dip-1up ] dip [ 3dip-1up ] call ; inline
+    [ call ] 3dip [ dip-1up ] 2dip
+    [ 2dip-1up ] dip [ 3dip-1up ] call ; inline
 
 : 3and ( a b c -- ? ) and and ; inline
 : 4and ( a b c d -- ? ) and and and ; inline
@@ -215,20 +230,25 @@ MACRO: 3keep-under ( quot -- quot' )
 MACRO: 4keep-under ( quot -- quot' )
     dup outputs 4 + '[ _ 4keep 4 _ 0 -nrotated ] ;
 
-! for use with assoc-map etc
-: 1temp1d ( quot: ( a b c -- d e f ) -- quot ) '[ swap @ swap ] ; inline
-: 1temp2d ( quot: ( a b c -- d e f ) -- quot ) '[ rot @ -rot ] ; inline
-: 2temp2d ( quot: ( a b c d -- e f g h ) -- quot ) '[ 2 4 0 nrotated @ 2 4 0 -nrotated ] ; inline
+! for use with assoc-map etc.
+: 1temp1d ( quot: ( a b c -- d e f ) -- quot )
+    '[ swap @ swap ] ; inline
+
+: 1temp2d ( quot: ( a b c -- d e f ) -- quot )
+    '[ rot @ -rot ] ; inline
 
+: 2temp2d ( quot: ( a b c d -- e f g h ) -- quot )
+    '[ 2 4 0 nrotated @ 2 4 0 -nrotated ] ; inline
+
+<PRIVATE
 : (closure-limit) ( vertex set quot: ( vertex -- edges ) i n -- )
     2dup < [
-        [ 1 + ] dip
-        2reach ?adjoin [
-            [ [ dip ] keep ] 2dip [ (closure-limit) ] 2curry 2curry each
+        [ 1 + ] dip 2reach ?adjoin [
+            [ [ dip ] keep ] 2dip
+            '[ _ _ _ _ (closure-limit) ] each
         ] [ 5drop ] if
-    ] [
-        5drop
-    ] if ; inline recursive
+    ] [ 5drop ] if ; inline recursive
+PRIVATE>
 
 : closure-limit-as ( vertex quot: ( vertex -- edges ) n exemplar -- set )
     [ 0 ] 2dip
@@ -237,10 +257,14 @@ MACRO: 4keep-under ( quot -- quot' )
 : closure-limit ( vertex quot: ( vertex -- edges ) n -- set )
     HS{ } closure-limit-as ; inline
 
-: 1check ( obj quot -- obj ? ) over [ call ] dip swap ; inline
-: 2check ( obj1 obj2 quot -- obj ? ) 2over [ call ] 2dip rot ; inline
+: 1check ( obj quot -- obj ? )
+    over [ call ] dip swap ; inline
+
+: 2check ( obj1 obj2 quot -- obj1 obj2 ? )
+    2over [ call ] 2dip rot ; inline
 
-: 1check-when ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a obj cond -- ..b ) -- ..b )
+: 1check-when ( ..a obj cond: ( ..a obj -- ? ) true: ( ..a obj -- ..b ) -- ..b )
     [ 1check ] dip when ; inline
-: 2check-when ( ..a obj1 obj2 cond: ( ..a obj1 obj2 -- obj/f ) true: ( ..a obj1 obj2 cond -- ..b ) -- ..b )
+
+: 2check-when ( ..a obj1 obj2 cond: ( ..a obj1 obj2 -- ? ) true: ( ..a obj1 obj2 -- ..b ) -- ..b )
     [ 2check ] dip when ; inline

diff --git a/misc/vim/README.md b/misc/vim/README.md
index 5c237fa03107fe632cc7291a1ccb9ba0d4fb9f36..923efb7bf8da699d3395f881ed84af632aa7a365 100644 (file)
--- a/misc/vim/README.md
+++ b/misc/vim/README.md
@@ -21,6 +21,7 @@ The current set of files is as follows:
 * plugin/factor.vim - Teach Vim some commands for navigating Factor source code. See below.
 * syntax/factor.vim - Teach Vim about highlighting Factor source code syntax.
   * syntax/factor/generated.vim - Syntax highlighting lessons generated from a Factor VM.
+* indent/factor.vim - Teach Vim to automatically indent Factor source code.
 
 ## Commands
 
@@ -73,8 +74,8 @@ The default value is `work`.
 ## Note
 
 The `syntax/factor/generated.vim` syntax highlighting file
-is automatically generated
-to include the names of all the vocabularies Factor knows about.
+is automatically generated to include the names of all the
+vocabularies Factor knows about.
 To regenerate it manually, run the following code in the listener:
 
     "editors.vim.generate-syntax" run