regexer-golfed.pl

use feature':5.12';
sub S(&){pop}
$,=S{goto pop};
sub p{push@{+shift},@_}
sub c{my$l=$,;for my$r(@_){my$L=$l;
$l=S{my($i,$c)=@_;&$L($i,S{&$r(shift,$c)})}}$l}
sub a{my@A=@_;S{my($i,$c,$o)=@_;$o=&$_($i,$c)and return$o for@A;0}}
sub A{$#_?a(map c(@$_),@_):c(@{+pop})}
sub k{my($I,$k)=@_;$k=a c($I,S{&$k}),$,}
$_=shift;$P=do{@a=$r=[];for(/./g){when('('){p\@p,[@a];@a=$r=[]}
when(')'){$p=A@a;@a=@{pop@p};p$r=$a[-1],$p}
p\@a,$r=[]when'|';p$r,k pop@$r when'*';
p$r,c $$r[-1],k pop@$r when'+';p$r,a pop@$r,$,when '?';
my$s=$_;p$r,S{my($_,$c)=@_;s/^\Q$s//&&$_->$c}}A@a};
say&$P($_,S{!length pop})?"true":"false"for@ARGV

regexer.pl

use feature ':5.10';

sub nil { # $, in golf
  my ($input, $cont) = @_;
  $cont->($input);
}

sub EOI { # inlined in the parser call in golf
  my ($input) = @_;
  length($input) == 0;
}

sub literal { # inlined in the builder in golf
  my ($match) = @_;
  sub {
    my ($input, $cont) = @_;
    if ($input =~ s/^\Q$match//) {
      $cont->($input);
    }
  }
}

sub concat_2 { # not in golf
  my ($left, $right) = @_;
  sub {
    my ($input, $cont) = @_;
    my $matchright = sub {
      my ($input) = @_;
      $right->($input, $cont); # $cont from outer
    };
    $left->($input, $matchright);
  }
}

sub concat { # sub c
  my $left = \&nil;
  for my $right (@_) {
    $left = concat_2($left, $right);
  }
  $left;
}

sub alternate { # sub a
  my @alternatives = @_;
  sub {
    my ($input, $cont) = @_;
    for my $alt (@alternatives) {
      if (my $result = $alt->($input, $cont)) {
        return $result;
      }
    }
    return; # all failed
  }
}

sub star { # sub k
  my ($inner) = @_;
  my $star;
  $star = alternate(
    concat_2( $inner, sub { $star->(@_) } ),
    \&nil
  );
  $star;
}

sub plus { # not in golfed
  my ($inner) = @_;
  return concat_2($inner, star($inner)),
}

sub maybe { # not in golfed
  my ($inner) = @_;

  return alternate($inner, \&nil);
}

# Takes a list of alternatives, each one of which is an arrayref holding
# a list of concatenated atoms. Calls concatenate() and alternate() on them
# in turn to build up a matcher. This is how we finalize either a paren group
# or the whole regex.
sub flatten {
  my @alternates = @_;
  if (@alternates > 1) {
    return alternate(
      map { concat(@$_) } @alternates
    );
  } else {
    return concat(@{ $alternates[0] });
  }
}

sub build_regex {
  my ($regex) = @_;

  my @alternatives =
     $concat = [];

  my @paren_groups;

  for (split //, $regex) {
    when ('(') {
      push @paren_groups, [ @alternatives ]; # Save on the stack
      @alternatives = $concat = []; # Clear the working space
    }
    when (')') {
      # Turn the current workspace into a real matcher
      my $current_group = flatten( @alternatives );
      # Pop back to where we were before we entered this paren
      @alternatives = @{ pop @paren_groups };
      $concat = @alternatives[-1];
      # And add the matcher for this paren group to the outer scope
      push @$concat, $current_group;
    }
    when ('|') {
      # Start a new empty concat list and push it on the alternatives
      $concat = [];
      push @alternatives, $concat;
    }
    when ('*') { # Replace last atom with a starred version of itself
      $concat->[-1] = star( $concat->[-1] );
    }
    when ('+') { # Replace last atom with a plussed version of itself
      $concat->[-1] = plus( $concat->[-1] );
    }
    when ('?') { # Replace last atom with a maybe'd version of itself
      $concat->[-1] = maybe( $concat->[-1] );
    }
    default { # Generate a literal char matcher
      push @$concat, literal($_); # inline in golf
    }
  }
  # Build the top-level matcher
  return flatten(@alternatives);
}

my $regex = shift(@ARGV);
my $parser = build_regex($regex);
for my $str (@ARGV) {
  if ($parser->($str, \&EOI)) { # EOI is inline in golf
    say "true";
  } else {
    say "false";
  }
}