Extend your language

From Rosetta Code
Task
Extend your language
You are encouraged to solve this task according to the task description, using any language you may know.
Control Structures

These are examples of control structures. You may also be interested in:

Some programming languages allow you to extend the language. While this can be done to a certain degree in most languages (e.g. by using macros), other languages go much further. Most notably in the Forth and Lisp families, programming per se is done by extending the language without any formal distinction between built-in and user-defined elements.

If your language supports it, show how to introduce a new flow control mechanism. A practical and useful example is a four-way branch:

Occasionally, code must be written that depends on two conditions, resulting in up to four branches (depending on whether both, only the first, only the second, or none of the conditions are "true"). In a C-like language this could look like the following:

  if (condition1isTrue) {
     if (condition2isTrue)
        bothConditionsAreTrue();
     else
        firstConditionIsTrue();
  }
  else if (condition2isTrue)
     secondConditionIsTrue();
  else
     noConditionIsTrue();

Besides being rather cluttered, the statement(s) for 'condition2isTrue' must be written down twice. If 'condition2isTrue' were a lengthy and involved expression, it would be quite unreadable, and the code generated by the compiler might be unnecessarily large.

This can be improved by introducing a new keyword if2. It is similar to if, but takes two conditional statements instead of one, and up to three 'else' statements. One proposal (in pseudo-C syntax) might be:

  if2 (condition1isTrue) (condition2isTrue)
     bothConditionsAreTrue();
  else1
     firstConditionIsTrue();
  else2
     secondConditionIsTrue();
  else
     noConditionIsTrue();

Pick the syntax which suits your language. The keywords 'else1' and 'else2' are just examples. The new conditional expression should look, nest and behave analogously to the language's built-in 'if' statement.

Ada[edit]

with Ada.Text_IO; use Ada.Text_IO;
 
procedure Test_If_2 is
 
type Two_Bool is range 0 .. 3;
 
function If_2(Cond_1, Cond_2: Boolean) return Two_Bool is
(Two_Bool(2*Boolean'Pos(Cond_1)) + Two_Bool(Boolean'Pos(Cond_2)));
 
begin
for N in 10 .. 20 loop
Put(Integer'Image(N) & " is ");
case If_2(N mod 2 = 0, N mod 3 = 0) is
when 2#11# => Put_Line("divisible by both two and three.");
when 2#10# => Put_Line("divisible by two, but not by three.");
when 2#01# => Put_Line("divisible by three, but not by two.");
when 2#00# => Put_Line("neither divisible by two, nor by three.");
end case;
end loop;
end Test_If_2;
Output:
 10 is divisible by two, but not by three.
 11 is neither divisible by two, nor by three.
 12 is divisible by both two and three.
 13 is neither divisible by two, nor by three.
 14 is divisible by two, but not by three.
 15 is divisible by three, but not by two.
 16 is divisible by two, but not by three.
 17 is neither divisible by two, nor by three.
 18 is divisible by both two and three.
 19 is neither divisible by two, nor by three.
 20 is divisible by two, but not by three.

ALGOL 68[edit]

# operator to turn two boolean values into an integer - name inspired by the COBOL sample #
PRIO ALSO = 1;
OP ALSO = ( BOOL a, b )INT: IF a AND b THEN 1 ELIF a THEN 2 ELIF b THEN 3 ELSE 4 FI;
 
# using the above operator, we can use the standard CASE construct to provide the #
# required construct, e.g.: #
BOOL a := TRUE, b := FALSE;
CASE a ALSO b
IN print( ( "both: a and b are TRUE", newline ) )
, print( ( "first: only a is TRUE", newline ) )
, print( ( "second: only b is TRUE", newline ) )
, print( ( "neither: a and b are FALSE", newline ) )
ESAC

C[edit]

This task requires syntax different from the if keyword in C. For example:

/* Four-way branch.
*
* if2 (firsttest, secondtest
* , bothtrue
* , firstrue
* , secondtrue
* , bothfalse
* )
*/

#define if2(firsttest,secondtest,bothtrue,firsttrue,secondtrue,bothfalse)\
switch(((firsttest)?0:2)+((secondtest)?0:1)) {\
case 0: bothtrue; break;\
case 1: firsttrue; break;\
case 2: secondtrue; break;\
case 3: bothfalse; break;\
}

 

Example application:

#include <limits.h>
#include <stdio.h>
#include <stdlib.h>
#include "if2.h"
 
int main(int argc, char *argv[]) {
int i;
for (i = 1; i < argc; i++) {
char *arg= argv[i], *ep;
long lval = strtol(arg, &ep, 10); /* convert arg to long */
if2 (arg[0] == '\0', *ep == '\0'
, puts("empty string")
, puts("empty string")
, if2 (lval > 10, lval > 100
, printf("%s: a very big number\n", arg)
, printf("%s: a big number\n", arg)
, printf("%s: a very big number\n", arg)
, printf("%s: a number\n", arg)
)
, printf("%s: not a number\n", arg)
)
}
return 0;
}

Example invocation:

$ make exten && ./exten 3 33 333 3a b " " -2
cc exten.c -o exten
3: a number
33: a big number
333: a very big number
3a: not a number
b: not a number
 : not a number
-2: a number

The following is probably easier to read, although fi2 is funny looking however you slice it. On the other hand, this kind of macros are unquestionably in the "bad" category.

#include <stdio.h>
 
#define if2(a, b) switch(((a)) + ((b)) * 2) { case 3:
#define else00 break; case 0: /* both false */
#define else10 break; case 1: /* true, false */
#define else01 break; case 2: /* false, true */
#define else2 break; default: /* anything not metioned */
#define fi2 } /* stupid end bracket */
 
int main()
{
int i, j;
for (i = 0; i < 3; i++) for (j = 0; j < 3; j++) {
printf("%d %d: ", i, j);
if2 (i == 1, j == 1)
printf("both\n");
else10
printf("left\n");
else01
printf("right\n");
else00 { /* <-- bracket is optional, flaw */,
printf("neither\n");
if2 (i == 2, j == 2)
printf("\tis 22");
printf("\n"); /* flaw: this is part of if2! */
else2
printf("\tnot 22\n");
fi2
}
fi2
}
 
return 0;
}

Clay[edit]

alias if2(cond1:Bool,
cond2:Bool,
both,
first,
second,
neither)
{
var res1 = cond1;
var res2 = cond2;
 
if (res1 and res2) return both;
if (res1) return first;
if (res2) return second;
return neither;
}
 

Clojure[edit]

Clojure being a LISP has macros.

 
(defmacro if2 [[cond1 cond2] bothTrue firstTrue secondTrue else]
`(let [cond1# ~cond1
cond2# ~cond2]
(if cond1# (if cond2# ~bothTrue ~firstTrue)
(if cond2# ~secondTrue ~else))))
 
> (if2 [true true] 'bothTrue 'firstTrue 'secondTrue 'else)
bothTrue
> (if2 [false true] 'bothTrue 'firstTrue 'secondTrue 'else)
secondTrue
> (if2 [true false] 'bothTrue 'firstTrue 'secondTrue 'else)
firstTrue
> (if2 [false false] 'bothTrue 'firstTrue 'secondTrue 'else)
else
> (macroexpand '(if2 ['c1 'c2] 'bothTrue 'firstTrue 'secondTrue 'else))
(let* [cond2__1806__auto__ (quote c2)] 
  (if (quote c1) (if cond2__1806__auto__ (quote bothTrue)   (quote firstTrue)) 
                 (if cond2__1806__auto__ (quote secondTrue) (quote else))))

COBOL[edit]

Cobol already has a multiple-if:

 
EVALUATE EXPRESSION-1 ALSO EXPRESSION-2
WHEN TRUE ALSO TRUE
DISPLAY 'Both are true.'
WHEN TRUE ALSO FALSE
DISPLAY 'Expression 1 is true.'
WHEN FALSE ALSO TRUE
DISPLAY 'Expression 2 is true.'
WHEN OTHER
DISPLAY 'Neither is true.'
END-EVALUATE
 

(Of course, Cobol is also inherently non-extensible.)

Common Lisp[edit]

(defmacro if2 (cond1 cond2 both first second &rest neither)
(let ((res1 (gensym))
(res2 (gensym)))
`(let ((,res1 ,cond1)
(,res2 ,cond2))
(cond ((and ,res1 ,res2) ,both)
(,res1 ,first)
(,res2 ,second)
(t ,@neither)))))

Interactive tests to validate if2.

  1. Forms evaluate once
  2. Forms evaluate in left-to-right order
  3. Suppressed antecedents do not evaluate
[1]>(defmacro tr (form) `(progn (format t "form ~s evaluating~%" ',form) ,form))
TR
[2]> (if2 (tr (< 1 2)) (tr (oddp 3)) (tr "both") (tr "first") (tr "second") (tr "neither"))
form (< 1 2) evaluating
form (ODDP 3) evaluating
form "both" evaluating
"both"
[3]> (if2 (tr (< 1 2)) (tr (oddp 4)) (tr "both") (tr "first") (tr "second") (tr "neither"))
form (< 1 2) evaluating
form (ODDP 4) evaluating
form "first" evaluating
"first"
[4]> (if2 (tr (< 2 1)) (tr (oddp 4)) (tr "both") (tr "first") (tr "second") (tr "neither"))
form (< 2 1) evaluating
form (ODDP 4) evaluating
form "neither" evaluating
"neither"

Proper nesting and hygiene: check by inspection of macro expansions.

  1. Axiom: standard language features LET and COND nest properly.
  2. The local variables introduced into the expansion by the generated LET are using unique uninterned symbols (obvious by #: notation) that cannot possibly occur in the code. Even if #:G2908 appears in code, two occurrences of that notation produce different symbol objects not EQ to each other, which just have the same name. Two occurrences of #:G2908 in the macro expansion are the same symbol, because they are just two insertions of the same object into the list structure.
  3. Function space hygiene is not a problem by fiat: Common Lisp programs which define their own functions called LET, COND invoke undefined behavior by the ANSI standard. Macros make liberal use of the standard operators in their expansions.
[1]> (macroexpand '(if2 c1 c2 b f s n1 n2 n3))
(LET ((#:G2907 C1) (#:G2908 C2))
 (COND ((AND #:G2907 #:G2908) B) (#:G2907 F) (#:G2908 S) (T N1 N2 N3))) ;
T
[2]> (macroexpand '(if2 c1 c2 b f s n1 n2 n3))
(LET ((#:G2909 C1) (#:G2910 C2))
 (COND ((AND #:G2909 #:G2910) B) (#:G2909 F) (#:G2910 S) (T N1 N2 N3))) ;
T

;;; show that multiple gensyms are the same symbol using Lisp's
;;; circle notation which reveals shared substructures and cycles

[3]> (setf *print-circle* t)
T
[4]> (macroexpand '(if2 c1 c2 b f s n1 n2 n3))
(LET ((#1=#:G2917 C1) (#2=#:G2918 C2))
 (COND ((AND #1# #2#) B) (#1# F) (#2# S) (T N1 N2 N3))) ;
T

D[edit]

D features lazy arguments, which can be used for this task.

void if2(T1, T2, T3, T4)(in bool c1, in bool c2,
lazy T1 first,
lazy T2 both,
lazy T3 second,
lazy T4 none) {
if (c1) {
if (c2)
both;
else
first;
} else {
if (c2)
second;
else
none;
}
}
 
void test(in bool a, in bool b) {
import std.stdio;
if2(a, b, writeln("first"),
writeln("both"),
writeln("second"),
writeln("none"));
}
 
void main() {
test(1 < 2, 3 > 4);
test(1 < 2, 1 < 2);
test(3 > 4, 3 > 4);
test(3 > 4, 1 < 2);
}
Output:
first
both
none
second

Delphi[edit]

First example:

 
procedure Check(Condition1: Boolean; Condition2: Boolean)
begin
if Condition1 = True then
begin
if Condition2 = True then
BothConditionsAreTrue
else
FirstConditionIsTrue;
end
else
if Condition2 = True then
SecondConditionIsTrue
else
NoConditionIsTrue;
end;

Second example:

 
procedure Check(Condition1: Boolean; Condition2: Boolean)
begin
if (Condition1 = True) and (Condition2 = True) then
BothConditionsAreTrue
else if Condition1 = True then
FirstConditionIsTrue
else if Condition2 = True then
SecondConditionIsTrue
else NoConditionIsTrue;
end;

In both examples if Condition1 and/or Condition2 are Booleans you can omit the '= True' (not when for instance comparing Integers: a = 1)

E[edit]

E may be thought of as like JavaScript or Smalltalk; you are expected to define control flow in terms of closures. In fact, all built-in loops internally expand to closures. However, we do provide (experimentally) a syntax for making your user-defined control structures look more like builtins.

The feature is called “lambda-args”, and it allows you to write controlName (args...) someKeyword params... { ... code ... } [ someKeyword params... { ... code ... }]*.

The control structure is built up and then executed by chained method calls (similar to jQuery) starting from the controlName object, one for each {}, each of which takes a closure as a parameter. The first closure actually returns the parenthesized args evaluated and a closure for the first {}, which the args are in scope for; the closures for all following {} do not have the args in scope.

pragma.enable("lambda-args") # The feature is still experimental syntax
 
def makeIf2Control(evalFn, tf, ft, ff) {
return def if2Control {
to only1__control_0(tf) { return makeIf2Control(evalFn, tf, ft, ff) }
to only2__control_0(ft) { return makeIf2Control(evalFn, tf, ft, ff) }
to else__control_0 (ff) { return makeIf2Control(evalFn, tf, ft, ff) }
to run__control() {
def [[a :boolean, b :boolean], # Main parameters evaluated
tt # First block ("then" case)
] := evalFn()
return (
if (a) { if (b) {tt} else {tf} } \
else { if (b) {ft} else {ff} }
)()
}
}
}
 
def if2 {
# The verb here is composed from the keyword before the brace, the number of
# parameters in the parentheses, and the number of parameters after the
# keyword.
to then__control_2_0(evalFn) {
# evalFn, when called, evaluates the expressions in parentheses, then
# returns a pair of those expressions and the first { block } as a
# closure.
return makeIf2Control(evalFn, fn {}, fn {}, fn {})
}
}
 
for a in [false,true] {
for b in [false,true] {
if2 (a, b) then {
println("both")
} only1 {
println("a true")
} only2 {
println("b true")
} else {
println("neither")
}
}
}

The internal expansion of the "if2" block above is:

if2.then__control_2_0(fn {
[[a, b], fn {
println("both")
}]
}).only1__control_0(fn {
println("a true")
}).only2__control_0(fn {
println("b true")
}).else__control_0(fn {
println("neither")
}).run__control()

EchoLisp[edit]

define-syntax and define-syntax-rules are here to extend the language

 
(define-syntax-rule
(if2 cond1 cond2 both cond1-only cond2-only none) ;; new syntax
;; will expand to :
(if cond1
(if cond2 both cond1-only)
(if cond2 cond2-only none)))
→ #syntax:if2
 
(define (num-test n)
(if2 (positive? n) (exact? n)
"positive and exact"
"positive and inexact"
"negative and exact"
"negative and inexact"))
 
(num-test 3/4)
"positive and exact"
(num-test -666)
"negative and exact"
(num-test -666.42)
"negative and inexact"
(num-test PI)
"positive and inexact"
 
 

Factor[edit]

Not too hard, as long as you're not worried about choking to death on stack effects:

( scratchpad ) : 2ifte ( ..a ?0 ?1 quot0: ( ..a -- ..b ) quot1: ( ..a -- ..b ) quot2: ( ..a -- ..b ) quot3: ( ..a -- ..b ) -- ..b )
[ [ if ] curry curry ] 2bi@ if ; inline
( scratchpad ) 3 [ 0 > ] [ even? ] bi [ 0 ] [ 1 ] [ 2 ] [ 3 ] 2ifte .
2

Forth[edit]

Control structures in Forth are just IMMEDIATE words, which flags them to be run at compile time. POSTPONE invokes the compile-time semantics of words instead of executing them.

\ in this construct, either of the ELSE clauses may be omitted, just like IF-THEN.
 
: BOTH postpone IF postpone IF ; immediate
: ORELSE postpone THEN postpone ELSE postpone IF ; immediate
: NEITHER postpone THEN postpone THEN ; immediate
 
: fb ( n -- )
dup 5 mod 0= over 3 mod 0=
BOTH ." FizzBuzz "
ELSE ." Fizz "
ORELSE ." Buzz "
ELSE dup .
NEITHER drop ;
: fizzbuzz ( n -- ) 0 do i 1+ fb loop ;
 

FreeBASIC[edit]

' FB 1.05.0 Win64
 
#Macro If2(condition1, condition2)
#Define Else1 ElseIf CBool(condition1) Then
#Define Else2 ElseIf CBool(condition2) Then
If CBool(condition1) AndAlso CBool(condition2) Then
#Endmacro
 
Sub test(a As Integer, b As Integer)
If2(a > 0, b > 0)
print "both positive"
Else1
print "first positive"
Else2
print "second positive"
Else
print "neither positive"
End If
End Sub
 
Dim As Integer a, b
Print "a = 1, b = 1 => ";
test(1, 1)
Print "a = 1, b = 0 => ";
test(1, 0)
Print "a = 0, b = 1 => ";
test(0, 1)
Print "a = 0, b = 0 => ";
test(0, 0)
Print
Print "Press any key to quit"
Sleep
Output:
a = 1, b = 1 => both positive
a = 1, b = 0 => first positive
a = 0, b = 1 => second positive
a = 0, b = 0 => neither positive

Haskell[edit]

Expressions in Haskell are not evaluated until they are needed, so ordinary functions can be control structures.

if2 :: Bool -> Bool -> a -> a -> a -> a -> a
if2 p1 p2 e12 e1 e2 e =
if p1 then
if p2 then e12 else e1
else if p2 then e2 else e
 
main = print $ if2 True False (error "TT") "TF" (error "FT") (error "FF")
 

Icon and Unicon[edit]

Icon, and Unicon, provide a means of programmatically adding new control regimes but not of extending the syntax for the same into a new control structure. Instead, a Programmer-Defined Control Operation (PDCO) may be defined and used. Here is an example:

procedure main(A)
if2 { (A[1] = A[2]), (A[3] = A[4]), # Use PDCO with all three else clauses
write("1: both true"),
write("1: only first true"),
write("1: only second true"),
write("1: neither true")
}
if2 { (A[1] = A[2]), (A[3] = A[4]), # Use same PDCO with only one else clause
write("2: both true"),
write("2: only first true"),
}
end
 
procedure if2(A) # The double-conditional PDCO
suspend if @A[1] then
if @A[2] then |@A[3] # Run-err if missing 'then' clause
else @\A[4] # (all else clauses are optional)
else if @A[2] then |@\A[5]
else |@\A[6]
end

and some sample runs:

->eyl 1 1 2 2 
1: both true
2: both true
->eyl 1 1 2 3
1: only first true
2: only first true
->eyl 1 2 2 2 
1: only second true
->eyl 1 2 3 4
1: neither true
->

The use of a PDCO does impose some restrictions over native control structures. The largest is that each clause in the PDCO is fully isolated from the others, so variables defined and used in one clause are not accessible in another (this includes, in this example, the two conditional clauses). Similarly, changes to procedure local variables made in any clause are not recorded outside the PDCO. So the use of PDCO is best viewed as a partial solution to this particular task.

Inform 7[edit]

Statement[edit]

Inform 7 has two syntaxes for flow control blocks. Unfortunately, the newer indentation-based syntax only works with the built-in flow control statements, but it's possible to define new flow control statements using the older begin...end syntax:

To if2 (c1 - condition) and-or (c2 - condition) begin -- end: (- switch (({c1})*2 + ({c2})) { 3: do -).
To else1 -- in if2: (- } until (1); 2: do { -).
To else2 -- in if2: (- } until (1); 1: do { -).
To else0 -- in if2: (- } until (1); 0: -).

Note that the "else0" part must be given, although "else1" and "else2" are optional. Demonstration:

Home is a room.
 
When play begins:
if2 (the player is in Home) and-or (the player is a person) begin;
say "both";
else1;
say "only 1";
else2;
say "only 2";
else0;
say "neither";
end if2.

Text substitution[edit]

To say if2 (c1 - condition) and-or (c2 - condition) -- beginning if2:
(- switch (({c1})*2 + ({c2})) { 3: -).
To say else1 -- continuing if2: (- 2: -).
To say else2 -- continuing if2: (- 1: -).
To say else0 -- continuing if2: (- 0: -).
To say end if2 -- ending if2: (- } -).

Demonstration:

Home is a room.
 
When play begins:
say "[if2 the player is not in Home and-or the player is not a person]both[else1]only 1[else2]only 2[else0]neither[end if2]".

J[edit]

In general, J's adverbs (1 :) and conjunctions (2 :) allow the creation of fairly arbitrary control words.

J's grammar uses a valence concept - originally from chemistry, but also used in linguistics. Briefly: J's nouns have no "binding potential" but can satisfy the binding needs of verbs, adverbs and conjunctions. Meanwhile, J's verbs can bind 1 or 2 nouns and can only produce a noun result. Verbs must bind with a noun on their right, and may optionally bind with a noun on their left (if and only if a noun is available for left binding). J's adverbs have a tight binding on their left which must be satisfied (and can be satisfied by either a noun or a verb). J's conjunctions have a tight binding on their left and right, both of which can be satisfied by either a noun or a verb. Adverbs and conjunctions can produce any kind of result (noun, adverb, conjunction, or verb) and their result's bindings must also be grammatically satisfied (in other words, they are somewhat like macros of other high level languages, though of course the formal details are a bit different).

Also, when creating an explicit definition using the : conjunction, the type of result is marked with a small integer indicating its binding potential: 0 (noun), 1 (adverb), 2 (conjunction), with higher values indicating various flavors of verbs (3 for the typical case).

Here, we extend our language by defining a conjunction if2 which consumes two nouns and produces a verb:

if2=: 2 :0
'`b1 b2'=. n
m@.(b1 + 2 * b2) f.
)

Example use:

f0=: [: smoutput 'neither option: ' , ":
f1=: [: smoutput 'first option: ' , ":
f2=: [: smoutput 'second option: ' , ":
f3=: [: smoutput 'both options: ' , ":
 
isprime=: 1&p:
iseven=: 0 = 2&|
 
f0`f1`f2`f3 if2 (isprime`iseven)"0 i.5
second option: 0
neither option: 1
both options: 2
first option: 3
second option: 4

That said, note that a switch statement which combines the boolean conditions as a base 2 number might be more convenient.

Note also that J allows words to be defined with the semantic properties that would in TCL be accessed using uplevel 1. However, these are often not useful in J in part because the natural approach to J programming has blocks be named (and referred to by name), and meaningful names are hard to come up with for these side-effect-based constructs but mostly because it's usually far more concise and clear to express the desired calculations directly.

(Also, most operations in J have built in data-driven looping (and, thus, conditional) capabilities - J automatically loops over all values in an array, and both data selection and multiplication can be used to handle conditional issues - so re-inventing that wheel rather quickly loses its luster.)

Kotlin[edit]

Kotlin does not have macros or the like but, using a combination of chained functions and lambdas, it's possible to create something which closely resembles a language extension:

// version 1.0.6
 
data class IfBoth(val cond1: Boolean, val cond2: Boolean) {
fun elseFirst(func: () -> Unit): IfBoth {
if (cond1 && !cond2) func()
return this
}
 
fun elseSecond(func: () -> Unit): IfBoth {
if (cond2 && !cond1) func()
return this
}
 
fun elseNeither(func: () -> Unit): IfBoth {
if (!cond1 && !cond2) func()
return this // in case it's called out of order
}
}
 
fun ifBoth(cond1: Boolean, cond2: Boolean, func: () -> Unit): IfBoth {
if (cond1 && cond2) func()
return IfBoth(cond1, cond2)
}
 
fun main(args: Array<String>) {
var a = 0
var b = 1
ifBoth (a == 1, b == 3) {
println("a = 1 and b = 3")
}
.elseFirst {
println("a = 1 and b <> 3")
}
.elseSecond {
println("a <> 1 and b = 3")
}
.elseNeither {
println("a <> 1 and b <> 3")
}
 
// It's also possible to omit any (or all) of the 'else' clauses or to call them out of order
a = 1
b = 0
ifBoth (a == 1, b == 3) {
println("a = 1 and b = 3")
}
.elseNeither {
println("a <> 1 and b <> 3")
}
.elseFirst {
println("a = 1 and b <> 3")
}
}
Output:
a <> 1 and b <> 3
a = 1 and b <> 3

Lasso[edit]

Lasso doesn't allow you to define new keywords for the parser, but it does allow you to achieve a similar effect using captures and givenblock as illustrated below.

// Create a type to handle the captures
 
define if2 => type {
data private a, private b
public oncreate(a,b) => {
.a = #a
.b = #b
thread_var_push(.type,self)
handle => { thread_var_pop(.type)}
return givenblock()
}
public ifboth => .a && .b ? givenblock()
public else1 => .a && !.b ? givenblock()
public else2 => !.a && .b ? givenblock()
public else => !.a && !.b ? givenblock()
}
 
// Define methods to consider givenblocks
 
define ifboth => thread_var_get(::if2)->ifboth => givenblock
define else1 => thread_var_get(::if2)->else1 => givenblock
define else2 => thread_var_get(::if2)->else2 => givenblock
define else => thread_var_get(::if2)->else => givenblock

Example use:

if2(true,true) => {
ifboth => {
bothConditionsAreTrue
}
else1 => {
firstConditionIsTrue
}
else2 => {
secondConditionIsTrue
}
else => {
noConditionIsTrue
}
}

Mathematica / Wolfram Language[edit]

Mathematica is not precisely a Lisp, but it can easily construct macros by holding the arguments to a function:

 
If2[test1_, test2_, condBoth_, cond1_, cond2_, condNone_] := With[
{result1 = test1,
result2 = test2},
Which[
result1 && result2, condBoth,
result1, cond1,
result2, cond2,
True, condNone]];
SetAttributes[If2, HoldAll];
 

Example usage (note that the tests are evaluated only once per call):

 
x = 0;
If2[Mod[(++x), 2] == 0, Mod[x, 3] == 1, Print["Both: ", x], Print["First: ", x], Print["Second: ", x], Print["Neither: ", x]];
If2[Mod[(++x), 2] == 0, Mod[x, 3] == 1, Print["Both: ", x], Print["First: ", x], Print["Second: ", x], Print["Neither: ", x]];
If2[Mod[(++x), 2] == 0, Mod[x, 3] == 1, Print["Both: ", x], Print["First: ", x], Print["Second: ", x], Print["Neither: ", x]];
If2[Mod[(++x), 2] == 0, Mod[x, 3] == 1, Print["Both: ", x], Print["First: ", x], Print["Second: ", x], Print["Neither: ", x]];
 
Output:
Second: 1
First: 2
Neither: 3
Both: 4

Morfa[edit]

Morfa's operator defining and overloading can be employed to provide more natural syntax for expressing an if2 "statement".

 
import morfa.base;
 
// introduce 4 new operators to handle the if2 syntax
operator then { kind = infix, precedence = mul, associativity = right}
operator else1 { kind = infix, precedence = not, associativity = left }
operator else2 { kind = infix, precedence = not, associativity = left }
operator none { kind = infix, precedence = not, associativity = left }
 
// function which bounds the condition expression to the if2 "actions"
public func then(condition: IF2.Condition, actionHolder: IF2): void
{
actionHolder.actions[condition]();
}
 
// functions (bound to operators) used to "build" the if2 "statement"
public func else1(bothAction: func(): void, else1Action: func(): void): IF2
{
return IF2([IF2.Condition.both -> bothAction,
IF2.Condition.else1 -> else1Action]);
 
}
public func else2(actionHolder: IF2, action: func(): void): IF2
{
return checkAndAdd(actionHolder, action, IF2.Condition.else2);
}
public func none(actionHolder: IF2, action: func(): void): IF2
{
return checkAndAdd(actionHolder, action, IF2.Condition.none);
}
 
// finally, function which combines two conditions into a "trigger" for the if2 "statement"
public func if2(condition1: bool, condition2: bool): IF2.Condition
{
if (condition1 and condition2)
return IF2.Condition.both;
else if (condition1)
return IF2.Condition.else1;
else if (condition2)
return IF2.Condition.else2;
else
return IF2.Condition.none;
}
 
// private helper function to build the IF2 structure
func checkAndAdd(actionHolder: IF2, action: func(): void, actionName: IF2.Condition): IF2
{
if (actionHolder.actions.contains(actionName))
throw new Exception("action defined twice for one condition in if2");
else
actionHolder.actions[actionName] = action;
return actionHolder;
}
 
// helper structure to process the if2 "statement"
struct IF2
{
public enum Condition { both, else1, else2, none };
public var actions: Dict<Condition, func(): void>;
}
 
// usage
if2 (true, false) then func()
{
println("both true");
}
else1 func()
{
println("first true");
}
else2 func()
{
println("second true");
}
none func()
{
println("none true");
};
 

Nemerle[edit]

In file "if2macro.n":

 
// point of interest: the when keyword and && operator inside the macro definition are macros themselves
 
macro if2 (cond1, cond2, bodyTT, bodyTF, bodyFT, bodyFF)
syntax ("if2", "(", cond1, ")", "(", cond2, ")", bodyTT, "elseTF", bodyTF, "elseFT", bodyFT, "else", bodyFF)
{
<[
when($cond1 && $cond2) {$bodyTT};
when($cond1 && !($cond2)) {$bodyTF};
when(!($cond1) && $cond2) {$bodyFT};
when(!($cond1) && !($cond2)) {$bodyFF};
]>
}

Compile with:

 ncc -r Nemerle.Compiler.dll -t:dll if2macro.n -o if2macro.dll

In file useif2.n:

using System;
using System.Console;
 
module UseIf2
{
Main() : void
{
def happy = true;
def knowit = false;
 
if2 (happy) (knowit)
Write("Clap hands")
elseTF
Write("You're happy")
elseFT
Write("Cheer up")
else
Write("You're unhappy, cheer up");
}
}
Compile with:
ncc -r if2macro.dll useif2.n

NewLISP[edit]

(context 'if2)
 
(define-macro (if2:if2 cond1 cond2 both-true first-true second-true neither)
(cond
((eval cond1)
(if (eval cond2)
(eval both-true)
(eval first-true)))
((eval cond2)
(eval second-true))
(true
(eval neither))))
 
(context MAIN)
 
> (if2 true true 'bothTrue 'firstTrue 'secondTrue 'else)
bothTrue
> (if2 true false 'bothTrue 'firstTrue 'secondTrue 'else)
firstTrue
> (if2 false true 'bothTrue 'firstTrue 'secondTrue 'else)
secondTrue
> (if2 false false 'bothTrue 'firstTrue 'secondTrue 'else)
else
 

Nim[edit]

import macros
 
proc newIfElse(c, t, e): PNimNode {.compiletime.} =
result = newIfStmt((c, t))
result.add(newNimNode(nnkElse).add(e))
 
macro if2(x, y: expr; z: stmt): stmt {.immediate.} =
var parts: array[4, PNimNode]
for i in parts.low .. parts.high:
parts[i] = newNimNode(nnkDiscardStmt).add(nil)
 
assert z.kind == nnkStmtList
assert z.len <= 4
 
for i in 0 .. <z.len:
assert z[i].kind == nnkCall
assert z[i].len == 2
 
var j = 0
 
case $z[i][0].ident
of "then": j = 0
of "else1": j = 1
of "else2": j = 2
of "else3": j = 3
else: assert false
 
parts[j] = z[i][1].last
 
result = newIfElse(x,
newIfElse(y, parts[0], parts[1]),
newIfElse(y, parts[2], parts[3]))
 
if2 2 > 1, 3 < 2:
then:
echo "1"
else1:
echo "2"
else2:
echo "3"
else3:
echo "4"
 
# Missing cases are supported:
if2 2 > 1, 3 < 2:
then:
echo "1"
else2:
echo "3"
else3:
echo "4"
 
# Order can be swapped:
if2 2 > 1, 3 < 2:
then:
echo "1"
else2:
echo "3"
else1:
echo "2"
else3:
echo "4"

PARI/GP[edit]

Of course the language can be extended with GP functions (starting with version 2.4.2, these are closures).

if2(c1,c2,tt,tf,ft,ff)={
if(c1,
if(c2,tt,tf)
,
if(c2,ft,ff)
)
};

GP can also be extended by adding C code directly to Pari:

GEN
if2(GEN c1, GEN c2, GEN tt, GEN tf, GEN ft, GEN ff)
{
if (gequal0(c1))
if (gequal0(c2))
return ff ? closure_evalgen(ff) : gnil;
else
return ft ? closure_evalgen(ft) : gnil;
else
if (gequal0(c2))
return tf ? closure_evalgen(tf) : gnil;
else
return tt ? closure_evalgen(tt) : gnil;
}

This function, when compiled to the file if2.gp.so, can be loaded into GP with the following commands:

install("if2","GGDEDEDEDE","if2","./if2.gp.so");
addhelp(if2, "if2(a,b,{seq1},{seq2},{seq3},{seq4}): if a is nonzero and b is nonzero, seq1 is evaluated; if a is nonzero and b is zero, seq2 is evaluated; if a is zero and b is nonzero, seq3 is evaluated; otherwise seq4. seq1 through seq4 are optional.");

Alternately, add these lines into the C course and run through gp2c-run:

/*
GP;install("if2","GGDEDEDEDE","if2","./if2.gp.so");
GP;addhelp(if2, "if2(a,b,{seq1},{seq2},{seq3},{seq4}): if a is nonzero and b is nonzero, seq1 is evaluated; if a is nonzero and b is zero, seq2 is evaluated; if a is zero and b is nonzero, seq3 is evaluated; otherwise seq4. seq1 through seq4 are optional.");
*/

Perl[edit]

Closures enable user-defined control structures, but the syntax is not always identical to that of built-in control structures. This example is a start, but needs improving.

 
#!/usr/bin/perl
use warnings;
use strict;
use v5.10;
 
=for starters
 
Syntax:
 
if2 condition1, condition2, then2 {
# both conditions are true
}
else1 {
# only condition1 is true
}
else2 {
# only condition2 is true
}
orelse {
# neither condition is true
};
 
Any (but not all) of the `then' and `else' clauses can be omitted, and else1
and else2 can be specified in either order.
 
This extension is imperfect in several ways:
* A normal if-statement uses round brackets, but this syntax forbids them.
* Perl doesn't have a `then' keyword; if it did, it probably wouldn't be
preceded by a comma.
* Unless it's the last thing in a block, the whole structure must be followed
by a semicolon.
* Error messages appear at runtime, not compile time, and they don't show the
line where the user's syntax error occurred.
 
We could solve most of these problems with a source filter, but those are
dangerous. Can anyone else do better? Feel free to improve or replace.
 
=cut

 
# All the new `keywords' are in fact functions. Most of them return lists
# of four closures, one of which is then executed by if2. Here are indexes into
# these lists:
 
use constant {
IdxThen => 0,
IdxElse1 => 1,
IdxElse2 => 2,
IdxOrElse => 3
};
 
# Most of the magic is in the (&) prototype, which lets a function accept a
# closure marked by nothing except braces.
 
sub orelse(&) {
my $clause = shift;
return undef, undef, undef, $clause;
}
 
sub else2(&@) {
my $clause = shift;
die "Can't have two `else2' clauses"
if defined $_[IdxElse2];
 
return (undef, $_[IdxElse1], $clause, $_[IdxOrElse]);
}
 
sub else1(&@) {
my $clause = shift;
die "Can't have two `else1' clauses"
if defined $_[IdxElse1];
 
return (undef, $clause, $_[IdxElse2], $_[IdxOrElse]);
}
 
sub then2(&@) {
die "Can't have two `then2' clauses"
if defined $_[1+IdxThen];
 
splice @_, 1+IdxThen, 1;
return @_;
}
 
# Here, we collect the two conditions and four closures (some of which will be
# undefined if some clauses are missing). We work out which of the four
# clauses (closures) to call, and call it if it exists.
 
use constant {
# Defining True and False is almost always bad practice, but here we
# have a valid reason.
True => (0 == 0),
False => (0 == 1)
};
 
sub if2($$@) {
my $cond1 = !!shift; # Convert to Boolean to guarantee matching
my $cond2 = !!shift; # against either True or False
 
die "if2 must be followed by then2, else1, else2, &/or orelse"
if @_ != 4
or grep {defined and ref $_ ne 'CODE'} @_;
 
my $index;
given ([$cond1, $cond2]) {
when ([False, False]) {$index = IdxOrElse}
when ([False, True ]) {$index = IdxElse2 }
when ([True, False]) {$index = IdxElse1 }
when ([True, True ]) {$index = IdxThen }
}
 
my $closure = $_[$index];
&$closure if defined $closure;
}
 
# This is test code. You can play with it by deleting up to three of the
# four clauses.
 
sub test_bits($) {
(my $n) = @_;
 
print "Testing $n: ";
 
if2 $n & 1, $n & 2, then2 {
say "Both bits 0 and 1 are set";
}
else1 {
say "Only bit 0 is set";
}
else2 {
say "Only bit 1 is set";
}
orelse {
say "Neither bit is set";
}
}
 
test_bits $_ for 0 .. 7;
 

Sample run:

 
[email protected]:~/perl$ ./if2
Testing 0: Neither bit is set
Testing 1: Only bit 0 is set
Testing 2: Only bit 1 is set
Testing 3: Both bits 0 and 1 are set
Testing 4: Neither bit is set
Testing 5: Only bit 0 is set
Testing 6: Only bit 1 is set
Testing 7: Both bits 0 and 1 are set
[email protected]:~/perl$
 

Perl 6[edit]

Writing the conditional blocks is no problem, since there's no distinction between built-in closures and user-defined. The if2 is currently just a function call, which requires a comma after the second condition; eventually we will be able to drop that in user-defined code, but none of our implementations can define parse actions in the statement_control category quite yet. (That syntax is special insofar as it's the only place Perl 6 allows two terms in a row.) So currently it requires the comma until the implementations catch up with the spec on that subject.

This solution is hygienic in both lexical and dynamic variables; the only caveat is that the user's program must avoid the dynamic variable being used by the implementation of conditional, $*IF2. This does not seem like a great hardship. (The conditionals will also nest correctly since that's how dynamic variables behave.)

my &if2  = -> \a, \b, &x { my @*IF2 = ?a,?b; x }
 
my &if-both = -> &x { x if @*IF2 eq (True,True) }
my &if-first = -> &x { x if @*IF2 eq (True,False) }
my &if-second = -> &x { x if @*IF2 eq (False,True) }
my &if-neither = -> &x { x if @*IF2 eq (False,False)}
 
sub test ($a,$b) {
$_ = "G"; # Demo correct scoping of topic.
my $got = "o"; # Demo correct scoping of lexicals.
my $*got = "t"; # Demo correct scoping of dynamics.
 
if2 $a, $b, {
if-both { say "$_$got$*got both" }
if-first { say "$_$got$*got first" }
if-second { say "$_$got$*got second" }
if-neither { say "$_$got$*got neither" }
}
}
 
say test |$_ for 1,0 X 1,0;
Output:
Got both
Got first
Got second
Got neither

Phix[edit]

Phix does not support macro programming. Generally I would suggest one of the following

switch {condition1,condition2} do
case {true,true}:
case {true,false}:
case {false,true}:
case {false,false}:
end switch

or

function if2(bool c1, bool c2)
return c1*10+c2
end function
 
switch if2(condition1,condition2) do
case 11:
case 10:
case 01:
case 00:
end switch

or

enum BOTH = 0b11, FIRST = 0b10, SECOND = 0b01, NEITHER = 0b00
 
function if2(bool c1, bool c2)
return c1*2+c2
end function
 
integer r = if2(condition1,condition2)
if r=BOTH then
elsif r=FIRST then
elsif r=SECOND then
elsif r=NEITHER then
end if

I can accept that those could all be deemed cheating (and that the last does not look anywhere near as nice as I hoped it would).

However Phix is designed to be easily modifiable (albeit not dynamically) and I think it would be instructive to outline the changes that would be needed to the compiler sources to achieve this task.

First decide on the syntax:

if2 condition1, condition2 then
    <block1>
else1
    <block2>
else2
    <block3>
else
    <block4>
end if2

and pseudocode to match the above (the last of the above three being the most suitable internally):

<tmp>=condition1*2+condition2
if <tmp>=0b11 then
    <block1>
elsif <tmp>=0b10 then
    <block2>
elsif <tmp>=0b01 then
    <block3>
else
    <block4>
end if

Next add new keywords. Find the last use of tt_stringF in pttree.e and add them. We do not know the ttidx values yet, so just duplicate the last one(5200)

global constant T_if2       = 5200  tt_stringF("if2",T_if2)
global constant T_else1 = 5200 tt_stringF("else1",T_else1)
global constant T_else2 = 5200 tt_stringF("else2",T_else2)

Then run p p and it will tell you what they should be

if2 should be 5208(not 5200)
else1 should be 5216(not 5200)
else2 should be 5224(not 5200)

Update the values and rebuild the compiler using "p -cp" (approx 10 seconds), then we can add the latter two to the block terminators (in pmain.e):

--constant T_endelseelsif = {T_end,T_else,T_elsif,T_case,T_default,T_fallthru,T_fallthrough}
constant T_endelseelsif = {T_end,T_else,T_else1,T_else2,T_elsif,T_case,T_default,T_fallthru,T_fallthrough}

Admittedly the next part is non-trivial. Not really worthwhile showing here, the distribution includes the file demo\rosetta\if2.txt which contains a DoIf2() procedure (120 lines) that is simply a quick hack of DoSwitch() and would be added to pmain.e

Lastly, that would need to be hooked in, find the DoSwitch call (again in pmain.e) and insert after it:

 elsif ttidx=T_if2 then      DoIf2()

Recompile Phix (p -cp, approx 10s) and test. Obviously, while I have subsequently removed it, I have tried this myself and it worked fine:

for N=10 to 20 do
printf(1,"%d is ",N)
if2 mod(N,2)=0, mod(N,3)=0 then
puts(1,"divisible by both two and three.\n")
else1
puts(1,"divisible by two, but not by three.\n")
else2
puts(1,"divisible by three, but not by two.\n")
else
puts(1,"neither divisible by two, nor by three.\n")
end if2
end for
Output:
10 is divisible by two, but not by three.
11 is neither divisible by two, nor by three.
12 is divisible by both two and three.
13 is neither divisible by two, nor by three.
14 is divisible by two, but not by three.
15 is divisible by three, but not by two.
16 is divisible by two, but not by three.
17 is neither divisible by two, nor by three.
18 is divisible by both two and three.
19 is neither divisible by two, nor by three.
20 is divisible by two, but not by three.

PHL[edit]

module stmts;
 
import phl::lang::io;
 
/* LinkedList --> Each element contains a condition */
struct @ConditionalChain {
field @Boolean cond;
field @ConditionalChain next;
 
@ConditionalChain init(@Boolean cond, @ConditionalChain next) [
this::cond = cond;
this::next = next;
 
return this;
]
 
/*
* If the condition is true executes the closure and returns a false element, otherwise returns the next condition
*
* Execution starts from the first element, and iterates until the right element is found.
*/
@ConditionalChain then(@Closure<@Void> closure) [
if (isNull(next())) return new @ConditionalChain.init(false, null);
if (cond()) {
closure();
return new @ConditionalChain.init(false, null);
}
else return next();
]
 
/* Operators create a cool look */
@ConditionalChain operator then(@Closure<@Void> closure) alias @ConditionalChain.then;
@ConditionalChain operator else1(@Closure<@Void> closure) alias @ConditionalChain.then;
@ConditionalChain operator else2(@Closure<@Void> closure) alias @ConditionalChain.then;
@ConditionalChain operator orElse(@Closure<@Void> closure) alias @ConditionalChain.then;
};
 
/* Returns linked list [a && b, a, b, true] */
@ConditionalChain if2(@Boolean a, @Boolean b) [
return new @ConditionalChain.init(a && b, new @ConditionalChain.init(a, new @ConditionalChain.init(b, new @ConditionalChain.init(true, null))));
]
 
@Void main [
if2(false, true) then [
println("Not this!");
] else1 [
println("Not this!");
] else2 [
println("This!");
] orElse [
println("Not this!");
];
]

PicoLisp[edit]

(undef 'if2)  # Undefine the built-in 'if2'
 
(de if2 "P"
(if (eval (pop '"P"))
(eval ((if (eval (car "P")) cadr caddr) "P"))
(if (eval (car "P"))
(eval (cadddr "P"))
(run (cddddr "P")) ) ) )

Usage:

(if2 (condition1isTrue) (condition2isTrue)
   (bothConditionsAreTrue)             # A single expression in each of the
   (firstConditionIsTrue)              # first three branches
   (secondConditionIsTrue)
   (noConditionIsTrue)                 # The final branch may contain
   (...) )                             # an arbitrary number of expressions

As another example of language extension, see Anonymous recursion#PicoLisp.

PowerShell[edit]

 
function When-Condition
{
[CmdletBinding()]
Param
(
[Parameter(Mandatory=$true, Position=0)]
[bool]
$Test1,
 
[Parameter(Mandatory=$true, Position=1)]
[bool]
$Test2,
 
[Parameter(Mandatory=$true, Position=2)]
[scriptblock]
$Both,
 
[Parameter(Mandatory=$true, Position=3)]
[scriptblock]
$First,
 
[Parameter(Mandatory=$true, Position=4)]
[scriptblock]
$Second,
 
[Parameter(Mandatory=$true, Position=5)]
[scriptblock]
$Neither
)
 
if ($Test1 -and $Test2)
{
return (&$Both)
}
elseif ($Test1 -and -not $Test2)
{
return (&$First)
}
elseif (-not $Test1 -and $Test2)
{
return (&$Second)
}
else
{
return (&$Neither)
}
}
 

Full syntax:

 
When-Condition -Test1 (Test-Path .\temp.txt) -Test2 (Test-Path .\tmp.txt) `
-Both { "both true"
} -First { "first true"
} -Second { "second true"
} -Neither { "neither true"
}
 
Output:
neither true

Alternate syntax:

 
Set-Alias -Name if2 -Value When-Condition
 
if2 $true $false {
"both true"
} { "first true"
} { "second true"
} { "neither true"
}
 
Output:
first true

Python[edit]

Macro programming is heavily discouraged in the Python community. One of the central tenets is that the Python syntax be immutable so that no matter what code is run, you have the assurance that the languages syntax stays the same.

However; having said that, Python allows deep reflection and there are packages such as MacroPy that would allow this task to be accomplished.

R[edit]

It is not possible to extend the language by adding keywords or creating macros. This kind of behaviour can be faked be creating functions that take expressions and evaluating them. (The switch and ifelse functions are existing examples.)

 
if2 <- function(condition1, condition2, both_true, first_true, second_true, both_false)
{
expr <- if(condition1)
{
if(condition2) both_true else first_true
} else if(condition2) second_true else both_false
eval(expr)
}
 

A test example:

 
for(x in 1:2) for(y in letters[1:2])
{
print(if2(x == 1, y == "a",
"both conditions are true",
x + 99,
{
yy <- rep.int(y, 10)
paste(letters[1:10], yy)
},
NULL
))
}
 

A variation that brings the syntax more in line with that described in the task is

 
if2 <- function(condition1, condition2, expr_list = NULL)
{
cl <- as.call(expr_list)
cl_name <- if(condition1)
{
if(condition2) "" else "else1"
} else if(condition2) "else2" else "else"
if(!nzchar(cl_name)) cl_name <- which(!nzchar(names(cl)))
eval(cl[[cl_name]])
}
 

The usage here is modified to

 
for(x in 1:2) for(y in letters[1:2])
{
print(if2(x == 1, y == "a", list(
"both conditions are true",
else1 = x + 99,
else2 =
{
yy <- rep.int(y, 10)
paste(letters[1:10], yy)
},
"else" = NULL
)))
}
 

Racket[edit]

Racket, like other Schemes, makes this kind of thing almost trivial:

 
#lang racket
;; define a new syntax
(define-syntax-rule
 ;; this is the new syntax we want, in sexpr syntax:
(if2 condition1isTrue condition2isTrue
bothConditionsAreTrue
firstConditionIsTrue
secondConditionIsTrue
noConditionIsTrue)
 ;; and this is the syntax that implements it:
(if condition1isTrue
(if condition2isTrue
bothConditionsAreTrue
firstConditionIsTrue)
(if condition2isTrue
secondConditionIsTrue
noConditionIsTrue)))
;; ... and that's all you need -- it now works:
(define (try x y)
(displayln (if2 (< x 10) (< y 10)
"Both small"
"First is small"
"Second is small"
"Neither is small")))
(try 1 1)  ; Both small
(try 1 10)  ; First is small
(try 10 1)  ; Second is small
(try 10 10) ; Neither is small
 

But as usual, Racket takes this much more seriously. For example, here is how the same looks in an upcoming infix-style language in Racket:

#lang honu

var else1 = 1
var else2 = 1

macro if2 (else1 else2 else) {
  (condition1isTrue:expression)
  (condition2isTrue:expression)
  bothConditionsAreTrue:expression
  else1 firstConditionIsTrue:expression
  else2 secondConditionIsTrue:expression
  else noConditionIsTrue:expression}
{
  syntax(if (condition1isTrue) {
           if (condition2isTrue)
             bothConditionsAreTrue
           else
             firstConditionIsTrue
         } else if (condition2isTrue)
           secondConditionIsTrue
         else
           noConditionIsTrue)
}

function try(x,y) {
  printf("~a\n", (if2 (x<10) (y<10) "Both small"
                  else1 "First is small"
                  else2 "Second is small"
                  else  "Neither is small"))
}
try(1, 1)   // Both small
try(1, 10)  // First is small
try(10, 1)  // Second is small
try(10, 10) // Neither is small

And here's another recent syntax experiment that was added:

#lang unstable/2d racket
(require unstable/2d/cond)
(define (try x y)
  (displayln
   #2dcond
   ╔═══════════╦═══════════════════╦════════════════════╗
   ║           ║ (< x 10 )         ║ (>= x 10 )         ║
   ╠═══════════╬═══════════════════╬════════════════════╣
   ║ (< y 10 ) ║ "Both small"      ║ "First is small"   ║
   ╠═══════════╬═══════════════════╬════════════════════╣
   ║ (>= y 10) ║ "Second is small" ║ "Neither is small" ║
   ╚═══════════╩═══════════════════╩════════════════════╝))
(try 1 1)   ; Both small
(try 1 10)  ; First is small
(try 10 1)  ; Second is small
(try 10 10) ; Neither is small

Retro[edit]

Since flow control is handled using combinators, we simply define a new one:

: 4wayIf ( flag flag both neither first second )
heap [ cons &cons dip [ [ cons ] dip ] dip rot ] preserve
[ do [ -1 = ] bi@ and ] [ 2drop do drop do ] when
[ do [ 0 = ] bi@ and ] [ 2drop do nip do ] when
[ do 0 = swap -1 = and ] [ drop nip do drop do ] when
[ do -1 = swap 0 = and ] [ drop nip do nip do ] when
drop 2drop ;

This is fairly noisy in terms of stack manipulations, but it's usage is clean and consistent with the rest of Retro:

: test
-1 -1 [ 1 ] [ 2 ] [ 3 ] [ 4 ] 4wayIf .s drop
0 0 [ 1 ] [ 2 ] [ 3 ] [ 4 ] 4wayIf .s drop
-1 0 [ 1 ] [ 2 ] [ 3 ] [ 4 ] 4wayIf .s drop
0 -1 [ 1 ] [ 2 ] [ 3 ] [ 4 ] 4wayIf .s drop ;

REXX[edit]

This REXX version is modeled after the   ADA   example.

Programming note:   the two arguments for the   if2   routine should be verified for having boolean values,
and also the number of arguments should be validated   (both have been omitted to make the code clearer).

Usage example:

if2(  some-expression-that-results-in-a-boolean-value,   some-other-expression-that-results-in-a-boolean-value)
 
 
/*this part is a REXX comment*/ /*could be a DO structure.*/
select /*↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓*/ /*↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓*/
 
when if.11 /*{condition 1 & 2 are true}*/ then perform-a-REXX-statement
when if.10 /*{condition 1 is true}*/ then " " " "
when if.01 /*{condition 2 is true}*/ then " " " "
when if.00 /*{no condition is true}*/ then " " " "
 
end
 
/*an example of a DO structure for the first clause: */
 
when if.11 /*{condition 1 & 2 are true}*/ then do; x=12; y=length(y); end
/*REXX program introduces the  IF2  "statement",   a type of a four-way compound  IF:   */
parse arg bot top . /*obtain optional arguments from the CL*/
if bot=='' | bot=="," then bot=10 /*Not specified? Then use the default.*/
if top=='' | top=="," then top=25 /* " " " " " " */
w=max(length(bot), length(top)) + 10 /*W: max width, used for displaying #.*/
 
do #=bot to top /*put a DO loop through its paces. */
/* [↓] divisible by two and/or three? */
if2( #//2==0, #//3==0) /*use a new four-way IF statement. */
select /*now, test the four possible cases. */
when if.11 then say right(#,w) " is divisible by both two and three."
when if.10 then say right(#,w) " is divisible by two, but not by three."
when if.01 then say right(#,w) " is divisible by three, but not by two."
when if.00 then say right(#,w) " isn't divisible by two, nor by three."
otherwise nop /*◄──┬◄ this statement is optional and */
end /*select*/ /* ├◄ only exists in case one or more*/
end /*#*/ /* └◄ WHENs (above) are omitted. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
if2: parse arg if.10, if.01 /*assign the cases of 10 and 01 */
if.11= if.10 & if.01 /* " " case " 11 */
if.00= \(if.10 | if.01) /* " " " " 00 */
return ''

output

          10  is    divisible by two, but not by three.
          11  isn't divisible by two, nor by three.
          12  is    divisible by both two and three.
          13  isn't divisible by two, nor by three.
          14  is    divisible by two, but not by three.
          15  is    divisible by three, but not by two.
          16  is    divisible by two, but not by three.
          17  isn't divisible by two, nor by three.
          18  is    divisible by both two and three.
          19  isn't divisible by two, nor by three.
          20  is    divisible by two, but not by three.
          21  is    divisible by three, but not by two.
          22  is    divisible by two, but not by three.
          23  isn't divisible by two, nor by three.
          24  is    divisible by both two and three.
          25  isn't divisible by two, nor by three.

Ruby[edit]

Ruby uses a hopelessly egocentric combinator (aka a combinator in which Kx = K for all x) and anonymous classes inherited from that combinator to do the job:

# Define a class which always returns itself for everything
class HopelesslyEgocentric
def method_missing(what, *args) self end
end
 
def if2(cond1, cond2)
if cond1 and cond2
yield
HopelesslyEgocentric.new
elsif cond1
Class.new(HopelesslyEgocentric) do
def else1; yield; HopelesslyEgocentric.new end
end.new
elsif cond2
Class.new(HopelesslyEgocentric) do
def else2; yield; HopelesslyEgocentric.new end
end.new
else
Class.new(HopelesslyEgocentric) do
def neither; yield end
end.new
end
end

Usage:

[true,false].product([true,false]).each do |cond1, cond2|
print "%5s, %5s => " % [cond1, cond2]
if2(cond1, cond2) do
puts "both true"
end.else1 do
puts "first is true"
end.else2 do
puts "second is true"
end.neither do
puts "neither is true"
end
end
Output:
 true,  true => both true
 true, false => first is true
false,  true => second is true
false, false => neither is true

Rust[edit]

#![allow(unused_variables)]
macro_rules! if2 {
($cond1: expr, $cond2: expr
=> $both:expr
=> $first: expr
=> $second:expr
=> $none:expr)
=> {
match ($cond1, $cond2) {
(true, true) => $both,
(true, _ ) => $first,
(_ , true) => $second,
_ => $none
}
}
}
 
fn main() {
let i = 1;
let j = 2;
if2!(i > j, i + j >= 3
=> {
// code blocks and statements can go here also
let k = i + j;
println!("both were true")
}
=> println!("the first was true")
=> println!("the second was true")
=> println!("neither were true")
)
}

Scala[edit]

Defining a new control construct:

scala> def if2[A](x: => Boolean)(y: => Boolean)(xyt: => A) = new {
| def else1(xt: => A) = new {
| def else2(yt: => A) = new {
| def orElse(nt: => A) = {
| if(x) {
| if(y) xyt else xt
| } else if(y) {
| yt
| } else {
| nt
| }
| }
| }
| }
| }
if2: [A](x: => Boolean)(y: => Boolean)(xyt: => A)java.lang.Object{def else1(xt: => A): java.lang.Object{def else2(yt: =>
A): java.lang.Object{def orElse(nt: => A): A}}}

Usage:

scala> if2(true)(true) {
| 1
| } else1 {
| 9
| } else2 {
| 11
| } orElse {
| 45
| }
res0: Int = 1
 
scala> if2(false)(true) {
| "Luffy"
| } else1 {
| "Nami"
| } else2 {
| "Sanji"
| } orElse {
| "Zoro"
| }
res1: java.lang.String = Sanji

Scheme[edit]

 
(define-syntax if2
(syntax-rules ()
((if2 cond1 cond2 both-true first-true second-true none-true)
(let ((c2 cond2))
(if cond1
(if c2 both-true first-true)
(if c2 second-true none-true))))))
 

Seed7[edit]

Seed7 allows the definition of statement syntax and semantic.

$ include "seed7_05.s7i";
 
$ syntax expr: .if.().().then.().else1.().else2.().else3.().end.if is -> 25;
 
const proc: if (in boolean: cond1) (in boolean: cond2) then
(in proc: statements1)
else1
(in proc: statements2)
else2
(in proc: statements3)
else3
(in proc: statements4)
end if is func
begin
if cond1 then
if cond2 then
statements1;
else
statements2;
end if;
elsif cond2 then
statements3;
else
statements4;
end if;
end func;
 
const proc: main is func
begin
if TRUE FALSE then
writeln("error TRUE TRUE");
else1
writeln("TRUE FALSE");
else2
writeln("error FALSE TRUE");
else3
writeln("error FALSE FALSE");
end if;
end func;

Shen[edit]

Like most Lisps, this is trivial in Shen.

(defmacro branch-if-macro
[branch-if Cond1 Cond2 Both Fst Snd None] ->
[if Cond1
[if Cond2 Both Fst]
[if Cond2 Snd None]])

Example:

 
(define try
X Y -> (branch-if (integer? X)
(integer? Y)
both-ints first-int second-int neither-int))
 
(map (/. X (do (print X) (nl)))
[(try 1 2) (try 1 1.5) (try 1.5 1) (try 1.5 1.5)])

Sidef[edit]

class if2(cond1, cond2) {
method then(block) { # both true
if (cond1 && cond2) {
block.run;
}
return self;
}
method else1(block) { # first true
if (cond1 && !cond2) {
block.run;
}
return self;
}
method else2(block) { # second true
if (cond2 && !cond1) {
block.run;
}
return self;
}
method else(block) { # none true
if (!cond1 && !cond2) {
block.run;
}
return self;
}
}
 
if2(false, true).then {
say "if2";
}.else1 {
say "else1";
}.else2 {
say "else2"; # <- this gets printed
}.else {
say "else"
}

Tcl[edit]

The core of Tcl's language-level extensibility are the uplevel and upvar commands, which respectively allow execution of arbitrary code in the caller's context and provide safe access to variables in the caller's context. To create an if2, only uplevel is required (together with list which does substitution-safe script generation as a side-effect):

proc if2 {cond1 cond2 bothTrueBody firstTrueBody secondTrueBody bothFalseBody} {
# Must evaluate both conditions, and should do so in order
set c1 [uplevel 1 [list expr $cond1]
set c2 [uplevel 1 [list expr $cond2]
# Now use that to decide what to do
if {$c1 && $c2} {
uplevel 1 $bothTrueBody
} elseif {$c1 && !$c2} {
uplevel 1 $firstTrueBody
} elseif {$c2 && !$c1} {
uplevel 1 $secondTrueBody
} else {
uplevel 1 $bothFalseBody
}
}

Demonstrating:

if2 {1 > 0} {"grill" in {foo bar boo}} {
puts "1 and 2"
} {
puts "1 but not 2"
} {
puts "2 but not 1"
} {
puts "neither 1 nor 2"
}

Which produces this output:

1 but not 2

Condition-free form[edit]

It's also possible to write this without any use of if at all, through the careful selection of variable names:

proc if2 {cond1 cond2 body00 body01 body10 body11} {
# Must evaluate both conditions, and should do so in order
# Extra negations ensure boolean interpretation
set c1 [expr {![uplevel 1 [list expr $cond1]]}]
set c2 [expr {![uplevel 1 [list expr $cond2]]}]
# Use those values to pick the script to evaluate
uplevel 1 [set body$c1$c2]
}

This behaves exactly as above, so shall not be repeated here.

Other language extension forms[edit]

Tcl includes very strong support for language extension. For example, consider this code which implements a integer looping command:

proc loop {varName lowerBound upperBound body} {
upvar 1 $varName var
for {set var $lowerBound} {$var <= $upperBound} {incr var} {
uplevel 1 $body
}
}

That implements, in a few lines of code, a new looping construct that does integer iteration and which supports both break and continue, as any loop should. The loop variable is “owned” by the context which calls the loop, and the loop body can access all local variables. It's all also completely safe against complex substitutions. Here's an example of use:

proc timestables {M N} {
loop i 1 $M {
loop j 1 $N {
puts "$i x $j = [expr {$i * $j}]"
}
}
}
timestables 3 3

Output:

1 x 1 = 1
1 x 2 = 2
1 x 3 = 3
2 x 1 = 2
2 x 2 = 4
2 x 3 = 6
3 x 1 = 3
3 x 2 = 6
3 x 3 = 9

TXR[edit]

Translation of: CommonLisp
(defmacro if2 (cond1 cond2 both first second . neither)
(let ((res1 (gensym))
(res2 (gensym)))
^(let ((,res1 ,cond1)
(,res2 ,cond2))
(cond ((and ,res1 ,res2) ,both)
(,res1 ,first)
(,res2 ,second)
(t ,*neither)))))

UNIX Shell[edit]

Bourne shells never have custom control structures. One can fake them with runtime evaluation, but the result has ugly syntax and evaluates code in the wrong scope.

Works with: Bourne Shell
if2() {
if eval "$1"; then
if eval "$2"; then eval "$3"; else eval "$4"; fi
else
if eval "$2"; then eval "$5"; else eval "$6"; fi
fi
}
if2 'test 7 -lt 9' 'test 7 -gt 9' '
echo both 1 and 2
'
'
echo 1 but not 2
'
'
echo 2 but not 1
'
'
echo neither 1 nor 2
'

es[edit]

Translation of: Tcl
fn if2 cond1 cond2 body11 body10 body01 body00 {
# Must evaluate both conditions, and should do so in order.
# Negation ensures a boolean result: a true condition becomes
# 1 for false; a false condition becomes 0 for true.
let (c1 = <={! $cond1}; c2 = <={! $cond2}) {
# Use those values to pick the body to evaluate.
$(body$c1$c2)
}
}
if2 {test 1 -gt 0} {~ grill foo bar boo} {
echo 1 and 2
} {
echo 1 but not 2
} {
echo 2 but not 1
} {
echo neither 1 nor 2
}

Ursala[edit]

Identifiers can't contain digits, so the function is named iftwo.

iftwo("p","q") <"both","justp","justq","neither"> = 
 
"p"?(
"q"?("both","justp"),
"q"?("justq","neither"))

The type of iftwo is that of a function taking a pair of predicates and returning a function that takes a list of four functions. A function of the form iftwo(p,q) <f,g,h,i> applied to an argument x will cause each predicate to be applied to x, and exactly one of f(x), g(x),h(x) or i(x) to be returned.

In general, almost anything about the language can be extended with sufficient effort, because most of the compiler's internal tables and data structures can be modified or substituted by the user. However, such extreme measures are not meant to be needed because higher order functions such as iftwo can be routinely defined and used as shown.