perlmacrosoperators

Implementing a Perl `implies` macro or operator


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


Solution

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

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

    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