CDE

Task/Extend-your-language/0DESCRIPTION

@@ -0,0 +1,32 @@
+{{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 analog to the language's built-in 'if' statement.

Task/Extend-your-language/C/extend-your-language-1.c

@@ -0,0 +1,16 @@
+/* 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;\
+	}

Task/Extend-your-language/C/extend-your-language-2.c

@@ -0,0 +1,24 @@
+#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;
+}

Task/Extend-your-language/C/extend-your-language-3.c

@@ -0,0 +1,9 @@
+$ 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

Task/Extend-your-language/C/extend-your-language-4.c

@@ -0,0 +1,34 @@
+#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;
+}

Task/Extend-your-language/Clay/extend-your-language.clay

@@ -0,0 +1,15 @@
+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;
+}

Task/Extend-your-language/Clojure/extend-your-language.clj

@@ -0,0 +1,5 @@
+(defmacro if2 [[cond1 cond2] bothTrue firstTrue secondTrue else]
+  `(let [cond1# ~cond1
+         cond2# ~cond2]
+     (if cond1# (if cond2# ~bothTrue   ~firstTrue)
+                (if cond2# ~secondTrue ~else))))

Task/Extend-your-language/Common-Lisp/extend-your-language.lisp

@@ -0,0 +1,9 @@
+(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)))))

Task/Extend-your-language/D/extend-your-language.d

@@ -0,0 +1,32 @@
+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);
+}

Task/Extend-your-language/Delphi/extend-your-language-1.delphi

@@ -0,0 +1,15 @@
+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;

Task/Extend-your-language/Delphi/extend-your-language-2.delphi

@@ -0,0 +1,10 @@
+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;

Task/Extend-your-language/E/extend-your-language-1.e

@@ -0,0 +1,44 @@
+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")
+        }
+    }
+}

Task/Extend-your-language/E/extend-your-language-2.e

@@ -0,0 +1,11 @@
+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()

Task/Extend-your-language/Forth/extend-your-language.fth

@@ -0,0 +1,14 @@
+\ 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 ;

Task/Extend-your-language/Haskell/extend-your-language.hs

@@ -0,0 +1,7 @@
+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")

Task/Extend-your-language/Perl/extend-your-language-1.pl

@@ -0,0 +1,136 @@
+#!/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;

Task/Extend-your-language/Perl/extend-your-language-2.pl

@@ -0,0 +1,10 @@
+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$

Task/Extend-your-language/PicoLisp/extend-your-language.l

@@ -0,0 +1,8 @@
+(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")) ) ) )

Task/Extend-your-language/R/extend-your-language-1.r

@@ -0,0 +1,8 @@
+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)
+}

Task/Extend-your-language/R/extend-your-language-2.r

@@ -0,0 +1,12 @@
+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
+  ))
+}

Task/Extend-your-language/R/extend-your-language-3.r

@@ -0,0 +1,10 @@
+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]])
+}

Task/Extend-your-language/R/extend-your-language-4.r

@@ -0,0 +1,13 @@
+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
+  )))
+}

Task/Extend-your-language/Ruby/extend-your-language-1.rb

@@ -0,0 +1,23 @@
+# 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

Task/Extend-your-language/Ruby/extend-your-language-2.rb

@@ -0,0 +1,9 @@
+if2(5 < x, x < 7) 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

Task/Extend-your-language/Scala/extend-your-language-1.scala

@@ -0,0 +1,17 @@
+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}}}

Task/Extend-your-language/Scala/extend-your-language-2.scala

@@ -0,0 +1,21 @@
+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

Task/Extend-your-language/Scheme/extend-your-language.ss

@@ -0,0 +1,7 @@
+(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))))))

Task/Extend-your-language/Tcl/extend-your-language-1.tcl

@@ -0,0 +1,15 @@
+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
+    }
+}

Task/Extend-your-language/Tcl/extend-your-language-2.tcl

@@ -0,0 +1,9 @@
+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"
+}

Task/Extend-your-language/Tcl/extend-your-language-3.tcl

@@ -0,0 +1,8 @@
+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]
+}

Task/Extend-your-language/Tcl/extend-your-language-4.tcl

@@ -0,0 +1,6 @@
+proc loop {varName lowerBound upperBound body} {
+    upvar 1 $varName var
+    for {set var $lowerBound} {$var <= $upperBound} {incr var} {
+        uplevel 1 $body
+    }
+}

Task/Extend-your-language/Tcl/extend-your-language-5.tcl

@@ -0,0 +1,8 @@
+proc timestables {M N} {
+    loop i 1 $M {
+        loop j 1 $N {
+            puts "$i x $j = [expr {$i * $j}]"
+        }
+    }
+}
+timestables 3 3