(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
aor
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?
You could use XS::Parse::Infix::FromPerl.
It provides a way of hooking into Perl's parser to provide a named infix operator. So,
EXPR1 implies EXPR2
syntax, andPragma 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 |