use warnings;
use strict;
use v5.10;

=for starters

Syntax:

    if2 condition1, condition2, then2 {
        
    }
    else1 {
        
    }
    else2 {
        
    }
    orelse {
        
    };

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





use constant {
    IdxThen     => 0,
    IdxElse1    => 1,
    IdxElse2    => 2,
    IdxOrElse   => 3
};




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 @_;
}





use constant {
    
    
    True  => (0 == 0),
    False => (0 == 1)
};

sub if2($$@) {
    my $cond1 = !!shift;    
    my $cond2 = !!shift;    

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




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;