kernel: document ?if ?when ?unless

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 404d31bb56cc37c49777bace18889388329cf48b..20f30b25ed84c41740f3cfca44ec764a93cd997c 100644 (file)
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -170,7 +170,7 @@ ARTICLE: "conditionals" "Conditional combinators"
 "Forms abstracting a common stack shuffle pattern:"
 { $subsections if* when* unless* }
 "Another form abstracting a common stack shuffle pattern:"
-{ $subsections ?if }
+{ $subsections ?if ?when ?unless }
 "Sometimes instead of branching, you just need to pick one of two values:"
 { $subsections ? }
 "Two combinators which abstract out nested chains of " { $link if } ":"

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 923da3ac3ae4db05e127b872a4700f2bfe797c95..5ef5daddafb7e62a81e93f2bf1c7085d5e312e57 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -200,6 +200,34 @@ HELP: or
     { $example "USING: kernel prettyprint ;" "\"hi\" 12.0 or ." "\"hi\"" }
 } ;
 
+HELP: or*
+{ $values
+    { "obj1" "a generalized boolean" }
+    { "obj2" "a generalized boolean" }
+    { "obj2/obj1" "a generalized boolean" }
+    { "second?" "boolean" }
+}
+{ $description "A version of " { $link or } " which prefers to return second argument instead of the first. The output " { $snippet "second?" } " tells you which object was returned." }
+{ $examples
+    "Prefers the second argument:"
+    { $example "USING: arrays kernel prettyprint ;"
+        "f 3 or* 2array ."
+        "{ 3 t }"
+    }
+    "Will also return the first:"
+    { $example "USING: arrays kernel prettyprint ;"
+        "3 f or* 2array ."
+        "{ 3 f }"
+    }
+    "Can return false:"
+    { $example "USING: arrays kernel prettyprint ;"
+        "f f or* 2array ."
+        "{ f f }"
+    }
+} ;
+
+{ or or* } related-words
+
 HELP: xor
 { $values { "obj1" "a generalized boolean" } { "obj2" "a generalized boolean" } { "?" "a generalized boolean" } }
 { $description "If exactly one input is false, outputs the other input. Otherwise outputs " { $link f } "." }
@@ -716,6 +744,82 @@ HELP: unless*
 "The following two lines are equivalent:"
 { $code "X [ Y ] unless*" "X dup [ ] [ drop Y ] if" } } ;
 
+HELP: ?call
+{ $values
+    { "obj/f" { $maybe object } } { "quot" quotation }
+    { "obj'/f" { $maybe object } }
+}
+{ $description "Call the quotation if " { $snippet "obj" } " is not " { $snippet "f" } "." }
+{ $examples
+    "Example:"
+    { $example "USING: kernel math prettyprint ;"
+        "5 [ sq ] ?call ."
+        "25"
+    }
+    "Example:"
+    { $example "USING: kernel math prettyprint ;"
+        "f [ sq ] ?call ."
+        "f"
+    }
+} ;
+
+HELP: ?if
+{ $values
+    { "default" object } { "cond" object } { "true" object } { "false" object }
+}
+{ $warning "The old " { $snippet "?if" } " word can be refactored:" { $code "[ .. ] [ .. ] ?if\n\nor* [ .. ] [ .. ] if" } }
+{ $description "Calls " { $snippet "cond" } " on the " { $snippet "default" } " object and if " { $snippet "cond" } " outputs a new object then the " { $snippet "true" } " quotation is called with that new object. Otherwise, calls " { $snippet "false" } " with the old object." }
+{ $examples
+    "Look up an existing word or make an error pair:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+\" [ search ] [ where first ] [ \"not found\" 2array ] ?if ."
+        "\"resource:core/math/math.factor\""
+    }
+    "Try to look up a word that doesn't exist:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+++++\" [ search ] [ where first ] [ \"not found\" 2array ] ?if ."
+        "{ \"+++++\" \"not found\" }"
+    }
+} ;
+
+HELP: ?when
+{ $values
+    { "default" object } { "cond" object } { "true" object }
+}
+{ $description "Calls " { $snippet "cond" } " on the " { $snippet "default" } " object and if " { $snippet "cond" } " outputs a new object then the " { $snippet "true" } " quotation is called with that new object. Otherwise, leaves the old object on the stack." }
+{ $examples
+    "Look up an existing word or make an error pair:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+\" [ search ] [ where first ] ?when ."
+        "\"resource:core/math/math.factor\""
+    }
+    "Try to look up a word that doesn't exist:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+++++\" [ search ] [ where first ] ?when ."
+        "\"+++++\""
+    }
+} ;
+
+HELP: ?unless
+{ $values
+    { "default" object } { "cond" object } { "false" object }
+}
+{ $description "Calls " { $snippet "cond" } " on the " { $snippet "default" } " object and if " { $snippet "cond" } " outputs a new object. Otherwise, calls " { $snippet "false" } " with the old object." }
+{ $examples
+    "Look up an existing word or make an error pair:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+\" [ search ] [ \"not found\" 2array ] ?unless ."
+        "+"
+    }
+    "Try to look up a word that doesn't exist:"
+    { $example "USING: arrays definitions kernel math prettyprint sequences vocabs.parser ;"
+        "\"+++++\" [ search ] [ \"not found\" 2array ] ?unless ."
+        "{ \"+++++\" \"not found\" }"
+    }
+} ;
+
+{ ?if ?when ?unless } related-words
+
 HELP: die
 { $description "Starts the front-end processor (FEP), which is a low-level debugger which can inspect memory addresses and the like. The FEP is also entered when a critical error occurs." }
 { $notes

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 9468ea6a9f16b3bbec2472b6fcf9fbfaf4c42435..563be7ef430a82fd46aff0d521c733ee16a2eaa4 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -171,20 +171,20 @@ DEFER: if
 : 2keepd ( ..a x y z quot: ( ..a x y z -- ..b ) -- ..b x y )
     3keep drop ; inline
 
+: ?call ( ..a obj/f quot: ( ..a obj -- ..a obj' )  -- ..a obj'/f ) dupd when ; inline
+
 : transmute ( old quot: ( old -- new/f ) -- new/old new? )
     keep over [ drop t ] [ nip f ] if ; inline
 
-: ?call ( old/f quot -- old'/f ) dupd when ; inline
-
 ! Default
 
-: ?when ( ..a obj cond: ( ..a obj -- obj/f ) true: ( ..a cond -- ..b ) -- ..b )
+: ?when ( ..a default cond: ( ..a default -- ..a new/f ) true: ( ..a new -- ..b ) -- ..b )
     [ transmute ] dip when ; inline
 
-: ?unless ( ..a obj cond: ( ..a obj -- obj/f ) false: ( ..a default -- ..b ) -- ..b )
+: ?unless ( ..a default cond: ( ..a default -- ..a new/f ) false: ( ..a default -- ..b ) -- ..b )
     [ transmute ] dip unless ; inline
 
-: ?if ( ..a obj cond true: ( ..a cond -- ..b ) false: ( ..a default -- ..b ) -- ..b )
+: ?if ( ..a default cond: ( ..a default -- ..a new/f ) true: ( ..a new -- ..b ) false: ( ..a default -- ..b ) -- ..b )
     [ transmute ] 2dip if ; inline
 
 ! Cleavers