⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{task}}{{Control Structures}}{{omit from|BBC BASIC}} Some programming languages allow you to [[wp:Extensible_programming|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.

ABAP

DATA(result) = COND #( WHEN condition1istrue = abap_true AND condition2istrue = abap_true THEN bothconditionsaretrue
                          WHEN condition1istrue = abap_true THEN firstconditionistrue
                          WHEN condition2istrue = abap_true THEN secondconditionistrue
                          ELSE noconditionistrue ).

=={{header|Ada}} ==

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;

{{out}}

 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.

Agda

Given agda's lack of a prelude, I have decided to define my own boolean type. That is however not necessary if you use, say, stdlib.



data Bool : Set where
  true : Bool
  false : Bool

if_then_else : ∀ {l} {A : Set l} -> Bool -> A -> A -> A
if true then t else e = t
if false then t else e = e

if2_,_then_else1_else2_else_ : ∀ {l} {A : Set l} -> (b1 b2 : Bool) -> (t e1 e2 e : A) -> A
if2 true , true then t else1 e1 else2 e2 else e = t
if2 true , false then t else1 e1 else2 e2 else e = e1
if2 false , true then t else1 e1 else2 e2 else e = e2
if2 false , false then t else1 e1 else2 e2 else e = e

example : Bool
example = if2 true , false then true else1 false else2 true else false

ALGOL 68

# 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

Arturo

if2 [cond1,cond2,both,one,two,none]{
	if $(and cond1 cond2) {
		both
	} {
		if cond1 { one } {
			if cond2 { two } {
				none
			}
		}
	}
}

if2 true false {
	print "both"
} {
	print "only first"
} {
	print "only second"
} {
	print "none"
}

=={{header|C}} == 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

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

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

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

(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.

Forms evaluate once

Forms evaluate in left-to-right order

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.

Axiom: standard language features LET and COND nest properly.

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.

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

Coq

Coq allows "[https://coq.inria.fr/refman/user-extensions/syntax-extensions.html syntax extensions]":


Notation "A /\ B" := (and A B)

C#



using System;
using System.Reflection;

namespace Extend_your_language
{


	class Program
	{

		public static void Main(string[] args)
		{
			Console.WriteLine();
			Console.WriteLine("Hello World!");
			Console.WriteLine();

			int x = 0;
			int y = 0;

			for(x=0;x<2;x++)
			{
				for(y=0;y<2;y++)
				{

					CONDITIONS( (x==0) , (y==0) ).
						IF2  ("METHOD1").
						ELSE1("METHOD2").
						ELSE2("METHOD3").
						ELSE ("METHOD4");

				}
			}

			Console.WriteLine();
			Console.Write("Press any key to continue . . . ");
			Console.ReadKey(true);
		}




		public static void METHOD1()
		{
			Console.WriteLine("METHOD 1 executed - both are true");
		}

		public static void METHOD2()
		{
			Console.WriteLine("METHOD 2 executed - first is true");
		}

		public static void METHOD3()
		{
			Console.WriteLine("METHOD 3 executed - second is true");
		}

		public static void METHOD4()
		{
			Console.WriteLine("METHOD 4 executed - both are false");
		}


		static int CONDITIONS(bool condition1, bool condition2)
		{
			int c = 0;
			if(condition1 && condition2)
				c = 0;
			else if(condition1)
				c = 1;
			else if(condition2)
				c = 2;
			else
				c = 3;

			return c;
		}
	}


	public static class ExtensionMethods
	{

		public static int IF2(this int value, string method)
		{
			if(value == 0)
			{
				MethodInfo m = typeof(Program).GetMethod(method);
				m.Invoke(null,null);
			}

			return value;
		}

		public static int ELSE1(this int value, string method)
		{
			if(value == 1)
			{
				MethodInfo m = typeof(Program).GetMethod(method);
				m.Invoke(null,null);
			}

			return value;
		}

		public static int ELSE2(this int value, string method)
		{
			if(value == 2)
			{
				MethodInfo m = typeof(Program).GetMethod(method);
				m.Invoke(null,null);
			}

			return value;
		}

		public static void ELSE(this int value, string method)
		{
			if(value == 3)
			{
				MethodInfo m = typeof(Program).GetMethod(method);
				m.Invoke(null,null);
			}
		}

	}
}


{{out| Program Output}}




Hello World!

METHOD 1 executed - both are true
METHOD 2 executed - first is true
METHOD 3 executed - second is true
METHOD 4 executed - both are false

Press any key to continue . . .



D

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);
}

{{out}}

first
both
none
second

Delphi

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)

DUP

DUP, a FALSE derivative, enables the user to define new functions and/or operators.

The proper syntax for an ordinary if-statement is

[ ][ ]?

The if operator ? checks the top stack element for its truth value and executes the leftmost lambda ([ ]) if true, and the rightmost lambda if false.

The truth value for false is 0.

The truth value for true is -1 (or any other nonzero number).

For the implementation of a new two-conditional if operator ¿ we keep the conventional if-syntax and extend it to 4 lambdas:

[ ][ ][ ][ ]¿ with the execution conditions (2nd stack value/top stack value) = [true/true][true/false][false/true][false/false]¿

Execution of the proper lambda can be realized by manipulating the return stack with ( (move from data stack to return stack) ) (move from return stack to data stack) in two nested if-blocks. Usually the start locations of lambdas and locations of operators like ? are stored on the return stack.

{two-conditional if operator implementation}
{    [    top cond. = true         ][      top cond. = false      ]}
{     [ 2nd = true ][2nd = false ]   [ 2nd = true ][ 2nd = false]  }
[(((([[)))!)))%%%%%][)))))!)%%%%%]?][[))))!))%%%%%][))))))!%%%%%]?]?]⇒¿

Example program:

0 1_['t,'t,]['t,'f,]['f,'t,]['f,'f,]¿

Resulting output of the example program:

ft

E

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

'''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

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

Free Pascal

Pascal can not be extended. FPC (the Free Pascal compile) does allow usage of macros, if enabled, and in a certain mode. However, the go-to method for implementing a four-way switch is to use a case-switch with a tuple.

Note, as of 2019‑09‑04 this construct works only with a trunk FPC version.

program fourWay(input, output, stdErr);
var
	tuple: record
			A: boolean;
			B: char;
		end;
begin
	tuple.A := true;
	tuple.B := 'Z';
	case tuple of
		(A: false; B: 'R'):
		begin
			writeLn('R is not good');
		end;
		(A: true; B: 'Z'):
		begin
			writeLn('Z is great');
		end;
		else
		begin
			writeLn('No');
		end;
	end;
end.

Forth

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 ;

Fortran

Fortran does not offer language extension facilities except in the form of allowing a programmer to define subroutines and especially functions, that extend the collection of library functions and which could look a bit like a new statement form if viewed sympathetically. Similarly, there is no built-in pre-processor (as in pl/i) which would enable the definition of what could look like an additional statement form. So, you're stuck with something like call DIRECTWRITE(F,FMT,B,X + 7) in place of WRITE (F,FMT) B,X + 7 where one is to pass over the appearance of "call" and disregard the placement of the ")" symbol.

Even so, Fortran programmers often confront a need for multiple condition tests, and, there being no [[Decision_tables|"decision table"]] construction, one might proceed as follows:

      LOGICAL A,B		!These are allocated the same storage
      INTEGER IA,IB		!As the default integer size.
      EQUIVALENCE (IA,A),(IB,B)	!So, this will cause no overlaps.

      WRITE (6,*) "Boolean tests via integers..."
      DO 199 IA = 0,1	!Two states for A.
        DO 199 IB = 0,1		!Two states for B.
          IF (IA) 666,99,109		!Not four ways, just three.
   99     IF (IB) 666,100,101		!Negative values are surely wrong.
  100     WRITE (6,*) "FF",IA,IB
          GO TO 199
  101     WRITE (6,*) "FT",IA,IB
          GO TO 199
  109     IF (IB) 666,110,111		!A second test.
  110     WRITE (6,*) "TF",IA,IB
          GO TO 199
  111     WRITE (6,*) "TT",IA,IB
  199 CONTINUE		!Both loops finish here.

      WRITE (6,*) "Boolean tests via integers and computed GO TO..."
      DO 299 IA = 0,1	!Two states for A.
        DO 299 IB = 0,1		!Two states for B.
          GO TO (200,201,210,211) 1 + IA*2 + IB	!Counting starts with one.
  200     WRITE (6,*) "FF",IA,IB
          GO TO 299
  201     WRITE (6,*) "FT",IA,IB
          GO TO 299
  210     WRITE (6,*) "TF",IA,IB
          GO TO 299
  211     WRITE (6,*) "TT",IA,IB
  299 CONTINUE		!Both loops finish here.

  300 WRITE (6,301)
  301 FORMAT (/,"Boolean tests via LOGICAL variables...",/
     1 " AB    IA    IB (IA*2 + IB)")
      A = .TRUE.	!Syncopation.
      B = .TRUE.	!Via the .NOT., the first pair will be FF.
      DO I = 0,1	!Step through two states.
        A = .NOT.A		!Thus generate F then T.
        DO J = 0,1		!Step through the second two states.
          B = .NOT.B			!Thus generate FF, FT, TF, TT.
          WRITE (6,302) A,B,IA,IB,IA*2 + IB	!But with strange values.
  302     FORMAT (1X,2L1,2I6,I8)		!Show both types.
        END DO			!Next value for B.
      END DO		!Next value for A.
      GO TO 999

  666 WRITE (6,*) "Huh?"

  999 CONTINUE
      END

Which is to say that prior to Fortran 66 there were no LOGICAL variables, so one employed integer variables and used integer arithmetic with + and * for .OR. and .AND. on variables with the obvious values of zero and one - though additional values may be considered for more complex state collections with more complex calculations in mind. This involves re-interpreting what might appear to be integer arithmetic, but is not much of an extension to the language. With the introduction of LOGICAL variables and their associated operators, the results could be unexpected, as shown in the third lot of output:


 Boolean tests via integers...
 FF           0           0
 FT           0           1
 TF           1           0
 TT           1           1
 Boolean tests via integers and computed GO TO...
 FF           0           0
 FT           0           1
 TF           1           0
 TT           1           1

Boolean tests via LOGICAL variables...
 AB    IA    IB (IA*2 + IB)
 FF     0     0       0
 FT     0    -1      -1
 TF    -1     0      -2
 TT    -1    -1      -3

Different compilers/systems may use different values for ''true'' and ''false'' and indeed on the IBM360 ''et seq'', Fortran and pl/i did just that. Nevertheless, it would be easy enough to extend the language by adding a function such as:

      INTEGER FUNCTION IF2(A,B)	!Combine two LOGICAL variables.
       LOGICAL A,B		!These.
        IF2 = 0			!Wasted effort if A is true.
        IF (A) IF2 = 2		!But it avoids IF ... THEN ... ELSE ... END IF blather.
        IF (B) IF2 = IF2 + 1	!This relies on IF2 being a variable. (Standard in F90+)
      END FUNCTION IF2		!Thus produce a four-way result.

which ignores the possibly peculiar numerical values of LOGICAL variables. The results of such a function could then be employed in a computed GO TO statement as above, or, in the SELECT CASE statement that is preferred by more modern programmers:

      SELECT CASE(IF2(A,B))
       CASE(B"00"); WRITE (6,*) "Both false."
       CASE(B"01"); WRITE (6,*) "B only."
       CASE(B"10"); WRITE (6,*) "A only."
       CASE(B"11"); WRITE (6,*) "Both true."
      END SELECT

But there is no extension to the allowed syntax, as such.

FreeBASIC

' 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

{{out}}


a = 1, b = 1 => both positive
a = 1, b = 0 => first positive
a = 0, b = 1 => second positive
a = 0, b = 0 => neither positive

Go

{{trans|Kotlin}}

Go does not have macros but, using a combination of chained methods and function literals, it's possible to create something which (if you squint) is similar to the Kotlin example. Of course one should never do this kind of thing in real code.

However, it's far less elegant. This is because, in Go, function arguments cannot be passed outside the method's parentheses and must be preceded by the func keyword.

package main

import "fmt"

type F func()

type If2 struct {cond1, cond2 bool}

func (i If2) else1(f F) If2 {
    if i.cond1 && !i.cond2 {
        f()
    }
    return i
}

func (i If2) else2(f F) If2 {
    if i.cond2 && !i.cond1 {
        f()
    }
    return i
}

func (i If2) else0(f F) If2 {
    if !i.cond1 && !i.cond2 {
        f()
    }
    return i
}

func if2(cond1, cond2 bool, f F) If2 {
    if cond1 && cond2 {
        f()
    }
    return If2{cond1, cond2}
}

func main() {
    a, b := 0, 1
    if2 (a == 1, b == 3, func() {
        fmt.Println("a = 1 and b = 3")
    }).else1 (func() {
        fmt.Println("a = 1 and b <> 3")
    }).else2 (func() {
        fmt.Println("a <> 1 and b = 3")
    }).else0 (func() {
        fmt.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, b = 1, 0
    if2 (a == 1, b == 3, func() {
        fmt.Println("a = 1 and b = 3")
    }).else0 (func() {
        fmt.Println("a <> 1 and b <> 3")
    }).else1 (func() {
        fmt.Println("a = 1 and b <> 3")
    })
}

{{out}}


a <> 1 and b <> 3
a = 1 and b <> 3

Haskell

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")

=={{header|Icon}} and {{header|Unicon}}==

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.

Idris

Idris provides the [http://docs.idris-lang.org/en/latest/tutorial/typesfuns.html#laziness Lazy] data type, which makes the computation of a parameter lazy.

if2 : Bool -> Bool -> Lazy a -> Lazy a -> Lazy a -> Lazy a -> a
if2 True True  v _ _ _ = v
if2 True False _ v _ _ = v
if2 False True _ _ v _ = v
if2 _     _    _ _ _ v = v

Inform 7

Statement

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

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

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

J's grammar uses a [[wp:Valence|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.)

Java

Java lambdas can go a long way towards allowing the implementation of lazy "branches", as this example shows.


public class If2 {

    public static void if2(boolean firstCondition, boolean secondCondition,
                           Runnable bothTrue, Runnable firstTrue, Runnable secondTrue, Runnable noneTrue) {
        if (firstCondition)
            if (secondCondition)
                bothTrue.run();
            else firstTrue.run();
        else if (secondCondition)
            secondTrue.run();
        else noneTrue.run();
    }
}

Usage:


import static If2.if2;
class Main {
    private static void print(String s) {
        System.out.println(s);
    }

    public static void main(String[] args) {
        // prints "both true"
        if2(true, true,
                () -> print("both true"),
                () -> print("first true"),
                () -> print("second true"),
                () -> print("none true"));
    }
}

To allow optional else branches, and perhaps a more readable syntax with named branches, a more Object-Oriented approach can be used:


public class If2 {
    private final boolean firstCondition;
    private final boolean secondCondition;

    public If2(boolean firstCondition, boolean secondCondition) {
        this.firstCondition = firstCondition;
        this.secondCondition = secondCondition;
    }

    public static If2 if2(boolean firstCondition, boolean secondCondition) {
        return new If2(firstCondition, secondCondition);
    }

    public If2 then(Runnable runnable) {
        if (firstCondition && secondCondition) {
            runnable.run();
        }
        return this;
    }

    public If2 elseNone(Runnable runnable) {
        if (!firstCondition && !secondCondition) {
            runnable.run();
        }
        return this;
    }

    public If2 elseIfFirst(Runnable runnable) {
        if (firstCondition && !secondCondition) {
            runnable.run();
        }
        return this;
    }

    public If2 elseIfSecond(Runnable runnable) {
        if (!firstCondition && secondCondition) {
            runnable.run();
        }
        return this;
    }
}

Usage (imports and main class ommited for brevity):


// prints "both true"
if2(true, true)
    .then(() -> print("both true"))
    .elseIfFirst(() -> print("first true"))
    .elseIfSecond(() -> print("second true"))
    .elseNone(() -> print("none true"));

// if we only care about both true and none true...
// prints "none true"
if2(false, false)
    .then(() -> print("both true"))
    .elseNone(() -> { // a lambda can have a block body
        print("none true");
    });

Julia

Julia has very powerful macros for metaprogramming. Code can be handled as a type of data in Julia. Julia macros are defined similarly to other functions, but are called with an '@' prior to the macro name, in order to distinguish macro calls from other function calls.


const CSTACK1 = Array{Bool,1}()
const CSTACK2 = Array{Bool,1}()
const CSTACK3 = Array{Bool,1}()

macro if2(condition1, condition2, alltrue)
    if !(length(CSTACK1) == length(CSTACK2) == length(CSTACK3))
        throw("prior if2 statement error: must have if2, elseif1, elseif2, and elseifneither")
    end
    ifcond1 = eval(condition1)
    ifcond2 = eval(condition2)
    if ifcond1 && ifcond2
        eval(alltrue)
        push!(CSTACK1, false)
        push!(CSTACK2, false)
        push!(CSTACK3, false)
    elseif ifcond1
        push!(CSTACK1, true)
        push!(CSTACK2, false)
        push!(CSTACK3, false)
    elseif ifcond2
        push!(CSTACK1, false)
        push!(CSTACK2, true)
        push!(CSTACK3, false)
    else
        push!(CSTACK1, false)
        push!(CSTACK2, false)
        push!(CSTACK3, true)
    end
end

macro elseif1(block)
    quote
        if pop!(CSTACK1)
            $block
        end
    end
end

macro elseif2(block)
    quote
        if pop!(CSTACK2)
            $block
        end
    end
end

macro elseifneither(block)
    quote
        if pop!(CSTACK3)
            $block
        end
    end
end


# Testing of code starts here

@if2(2 != 4, 3 != 7, begin x = "all"; println(x) end)

@elseif1(begin println("one") end)

@elseif2(begin println("two") end)

@elseifneither(begin println("neither") end)


@if2(2 != 4, 3 == 7, println("all"))

@elseif1(begin println("one") end)

@elseif2(begin println("two") end)

@elseifneither(begin println("neither") end)


@if2(2 == 4, 3 != 7, begin x = "all"; println(x) end)

@elseif1(begin println("one") end)

@elseif2(begin println("two") end)

@elseifneither(begin println("neither") end)


@if2(2 == 4, 3 == 7, println("last all") end)

@elseif1(begin println("one") end)

@elseif2(begin println("two") end)

@elseifneither(begin println("neither") end)

{{output}}


all
one
two
neither

Kotlin

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")
    }
}

{{out}}


a <> 1 and b <> 3
a = 1 and b <> 3

Lasso

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
    }
}

M2000 Interpreter

M2000 Interpreter can use modules as statements, we can replace built-in statements with own, but not for control statements. Control statements use a layer above ordinary statements. So we can make a ELSE module, and that module can executed as module, but when an Else executed as part of an If structure then that ELSE can't be the new one.

Another problem is the scope of variables. We can pass an anonymous function, and call it with no return value, but that function can't see variables from the caller side.

In this example, we use Part { } as controlvariable. Originally this structure do this: if control value is false then control value set to true and block executed, and at the exit control value reset to false. This planned for exclusive run of a block. Also in this example we use the current stack to pass (and leave values), from one statement (here are modules), to other. In first if2 we pass by reference the control value which we use in all "parts"

So how we pass a value by reference in a stack which always pass by value?

A reference &ctrl is a string in M2000. We can use Print &ctrl and we can use it in string expressions too. So we push to stack a string with the absolute name of current ctrl variable. This is a weak reference, and for using it there is some ways, the easy one is to link it to local name, and this done using read &c.

Because Read &c drop the string (which is a weak reference) from stack, and we want this to be used for other parts, before the read statement we perform a over 3 which copy the 3rd item from stack and place it as new top, so leave 4 items, with first and fourth with the same value.

Conditions first pushed to stack, so we read them with stackitem() which reads from 1 to stack.size. We can miss 1 for top, so stackitem() is the top item. If we wish to get a string we have to use stackitem$(). M2000 is a "super" basic, and use $ for strings variables and functions in string expressions.

We can use nested if2 with same ctrl value, because ctrl programmed each time before a part block.


module if2 {
             over 3 : read &c
             c=not (stackitem() and stackitem(2))
}
module ifelse1 {
             over 3 : read &c
             c=not (stackitem() and not stackitem(2))
}
module ifelse2 {
             over 3 : read &c
             c=not (stackitem(2) and not stackitem())
}
module ifelse {
             over 3 : read &c
             c=stackitem() or stackitem(2)
}
module endif2 {
             if not empty then drop 3
}
ctrl=true
for a=1 to 2
      for b=1 to 2
            Print "a=";a, "b=";b
            if2 a=1, b=2, &ctrl : Part {
                  print "both", a, b
            } as ctrl
            ifelse1 : Part {
                  print "first", a
            } as ctrl
            ifelse2  : Part {
                  print "second", b
            } as ctrl
            ifelse  : part {
                  print "no one"
            } as ctrl
            endif2
      next b
next a
Print "ok"


=={{header|Mathematica}} / {{header|Wolfram Language}}== 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]];

{{out}}


Second: 1
First: 2
Neither: 3
Both: 4

Morfa

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

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

(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

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

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

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;
    if (!$cond1 && !$cond2) {$index = IdxOrElse}
    if (!$cond1 &&  $cond2) {$index = IdxElse2 }
    if ( $cond1 && !$cond2) {$index = IdxElse1 }
    if ( $cond1 &&  $cond2) {$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:

msl@64Lucid:~/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 msl@64Lucid:~/perl$



## Perl 6

Writing the conditional blocks is no problem, since there's no distinction between built-in closures and user-defined.  The <tt>if2</tt> 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, <tt>$*IF2</tt>.  This does not seem like a great hardship.  (The conditionals will also nest correctly since that's how dynamic variables behave.)

```perl6
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;

{{out}}

Got both
Got first
Got second
Got neither

Phix

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

{{Out}}


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

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

(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


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"
}

{{Out}}


neither true

Alternate syntax:


Set-Alias -Name if2 -Value When-Condition

if2 $true $false {
    "both true"
} { "first true"
} { "second true"
} { "neither true"
}

{{Out}}


first true

Python

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 [https://github.com/lihaoyi/macropy MacroPy] that would allow this task to be accomplished.

=={{header|R}} == 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

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

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

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.

Ring


# Project : Extend your language

see "a = 1, b = 1 => "
test(1, 1)
see "a = 1, b = 0 => "
test(1, 0)
see "a = 0, b = 1 => "
test(0, 1)
see "a = 0, b = 0 => "
test(0, 0)
see nl

func test(a,b)
       if a > 0 and b > 0
          see "both positive"
       but a > 0
           see "first positive"
       but b > 0
           see "second positive"
       but a < 1 and b < 1
           see "neither positive"
       ok
       see nl

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

Ruby

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

{{out}}


 true,  true => both true
 true, false => first is true
false,  true => second is true
false, false => neither is true

Rust

#![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

Defining a new control construct:

 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:

 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


(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

Seed7 allows the definition of statement [http://seed7.sourceforge.net/manual/syntax.htm 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

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

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

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 === 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

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

{{trans|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

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

= {{trans|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

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.

ZX Spectrum Basic

The only way to formally create additional commands for ZX Spectrum Basic is by attaching an Interface 1 and defining the command in machine code. However, we can work with the fact that boolean comparisons are evaluated numerically by defining a new function with the value table.

10 DEF FN i()=((NOT (a OR b))+2*(a AND NOT b)+3*(b AND NOT a)+4*(a AND b)): REM the function can be placed anywhere in the program, but it gets executed faster if it's at the top
20 FOR x=1 TO 20
30 LET a=(x/2)=INT (x/2): REM comparison 1
40 LET b=(x/3)=INT (x/3): REM comparison 2
50 GO TO 50+10*FN i(): REM cases
60 PRINT x;" is not divisible by 2 or 3": GO TO 100
70 PRINT x;" is divisible by 2": GO TO 100
80 PRINT x;" is divisible by 3": GO TO 100
90 PRINT x;" is divisible by 2 and 3"
100 NEXT x

{{out}}

1 is not divisible by 2 or 3
2 is divisible by 2
3 is divisible by 3
4 is divisible by 2
5 is not divisible by 2 or 3
6 is divisible by 2 and 3
7 is not divisible by 2 or 3
8 is divisible by 2
9 is divisible by 3
10 is divisible by 2
11 is not divisible by 2 or 3
12 is divisible by 2 and 3
13 is not divisible by 2 or 3
14 is divisible by 2
15 is divisible by 3
16 is divisible by 2
17 is not divisible by 2 or 3
18 is divisible by 2 and 3
19 is not divisible by 2 or 3
20 is divisible by 2

0 OK, 100:1

{{omit from|Ada}} {{omit from|Commodore BASIC}} {{omit from|Integer BASIC}} {{omit from|Java}} {{omit from|Lily}} {{omit from|NetRexx}} {{omit from|PureBasic}} {{omit from|Stata}} {{omit from|Yorick}} {{omit from|zkl}}