Implementing a Perl `implies` macro or operator

Question

(I read Writing a macro in Perl, but still need directions)

Eiffel has an implies operator (Implicative boolean operator, see "8.5.20 Syntax: Operators" in ECMA-367, 2nd edition), i.e.

a implies b

meaning

not a or b

So the first attempt was to use

# a implies b (a --> b)
sub implies($$)
{
    return !$_[0] || $_[1];
}

However that's a function, and not an operator. Specifically the short-cut evaluation fails for cases like

implies(defined($a), $a eq '@')

(resulting in "Use of uninitialized value $a in string eq at ...").

So the question is (for Perl 5.18.2): Is there an elegant way to add such an "operator" to Perl?

Answer 1

You could use XS::Parse::Infix::FromPerl.

It provides a way of hooking into Perl's parser to provide a named infix operator. So,

• You can introduce the EXPR1 implies EXPR2 syntax, and
• you can implement short-circuiting behaviour.

Pragma module: (It's effect is lexically-scoped like use strict;.)

package Syntax::Feature::Implies;

# Usage: `use syntax qw( implies );`
# Provides: `EXPR1 implies EXPR2`

use strict;
use warnings;

use Optree::Generate           qw( newLOGOP newUNOP OP_OR OP_NOT );
use XS::Parse::Infix::FromPerl qw( register_xs_parse_infix XPI_CLS_LOGICAL_OR_MISC );

my $hintkey = __PACKAGE__;

sub import   { $^H{ $hintkey } = 1; }
sub unimport { $^H{ $hintkey } = 0; }

*install   = \&import;    # For syntax.pm
*uninstall = \&unimport;  # For syntax.pm

register_xs_parse_infix(
   implies => (
      cls => XPI_CLS_LOGICAL_OR_MISC,  # Same precedence as `||`.
      permit_hintkey => $hintkey,
      new_op => sub {
         #my ( $flags, $lhs, $rhs, $parsedata, $hookdata ) = @_;
         return newLOGOP( OP_OR, 0,
            newUNOP( OP_NOT, 0, $_[1] ),
            $_[2],
         );
      },
   )
);

1;

Test script:

#!/usr/bin/perl

use strict;
use warnings;

use feature qw( say );
use syntax qw( implies );  # Or use Syntax::Feature::Implies;

for my $p ( 0 .. 1 ) {
for my $q ( 0 .. 1 ) {
   my $rhs_evaluated = 0;
   my $r = $p implies do { ++$rhs_evaluated; $q };
   say "$p implies $q = $r  rhs ".( $rhs_evaluated ? "" : "not " )."evaluated";
}}

Output:

0 implies 0 = 1  rhs not evaluated
0 implies 1 = 1  rhs not evaluated
1 implies 0 = 0  rhs evaluated
1 implies 1 = 1  rhs evaluated

I gave it the same precedence as || (untested), but that can be tweaked.

cls	Same precedence as
XPI_CLS_LOGICAL_AND_MISC	&&
XPI_CLS_LOGICAL_OR_MISC	||, ^^, //
XPI_CLS_LOGICAL_AND_LOW_MISC	and
XPI_CLS_LOGICAL_OR_LOW_MISC	or, xor