bfjoust.pl

#!/usr/bin/perl
# -*- cperl -*-
use strict;
use warnings;
use feature ":5.10";
use Fatal qw/open/;

my $debug = 1;
$/=undef;
$\="\n";
$,=" ";
my ($fh1,$fh2);
open $fh1, '<', shift;
open $fh2, '<', shift;
my $p1 = <$fh1>;
my $p2 = <$fh2>;
close $fh1;
close $fh2;
$p1 =~ y/+\-<>.[]()*0-9%{}//cd;
$p2 =~ y/+\-<>.[]()*0-9%{}//cd;
print $p1 if $debug;
print $p2 if $debug;
my $tapemaxel = int(rand(20))+10;
my @tape = (0) x ($tapemaxel+1);
my ($i1,$i2) = (0, $tapemaxel);
@tape[$i1,$i2]=(128,128);
my $steps = 0;
my ($warn1,$warn2) = (0,0);
my $bgroup = qr/(?<BGROUP>\((?:[\-+<>.*0-9%{}]|(?&BGROUP))*\))/;
while ($steps++ < 100000) {
  my ($ce1,$ce2) = @tape[$i1,$i2];
  last if $ce1 && $ce2 && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
  {{
    $p1 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
      $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
    $p2 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
      $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
    $p1 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
	      \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
		(?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
	    \%(?<NUM>[0-9]+)/
	     $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
    $p2 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
	      \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
		(?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
	    \%(?<NUM>[0-9]+)/
	     $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
  }}
  $p1 = '.' if $p1 eq '';
  $p2 = '.' if $p2 eq '';

  given (substr ($p1,0,1,'')) {
    when ('.') {}
    when ('+') {$tape[$i1]++;    $tape[$i1]%=256;}
    when ('-') {$tape[$i1]+=255; $tape[$i1]%=256;}
    when ('<') {$i1--;}
    when ('>') {$i1++;}
    when ('[') {
      $p1 = "[$p1";
      if($ce1 > 0) {
	$p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
      else {
	$p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
    default {die "$_$p1";}}
  given (substr ($p2,0,1,'')) {
    when ('.') {}
    when ('+') {$tape[$i2]++;    $tape[$i2]%=256;}
    when ('-') {$tape[$i2]+=255; $tape[$i2]%=256;}
    when ('<') {$i2++;}
    when ('>') {$i2--;}
    when ('[') {
      $p2 = "[$p2";
      if($ce2 > 0) {
	$p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
      else {
	$p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
    default {die "$_$p2"};}
  print substr $p1,0,80 if $debug;
  print substr $p2,0,80 if $debug;
  print @tape if $debug;
  last if $p1 eq '' && $p2 eq '';
  last if $i1 < 0 || $i2 < 0 || $i1 > $tapemaxel || $i2 > $tapemaxel;
  $tape[0]          == 0 ? ($warn1++) : ($warn1=0);
  $tape[$tapemaxel] == 0 ? ($warn2++) : ($warn2=0);
  last if $warn1 == 2 || $warn2 == 2; }

my ($p1wins,$p2wins) = (0,0);
print "Both programs finished." if "$p1$p2" eq '';
print "Both programs are waiting."
  if $tape[$i1] && $tape[$i2] && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
$p2wins++, print "Program 1 went off the left end."  if $i1 < 0;
$p1wins++, print "Program 2 went off the right end." if $i2 < 0;
$p2wins++, print "Program 1 went off the right end." if $i1 > $tapemaxel;
$p1wins++, print "Program 2 went off the left end."  if $i2 > $tapemaxel;
$p2wins++, print "Program 1's flag fell." if $warn1 == 2;
$p1wins++, print "Program 2's flag fell." if $warn2 == 2;
print "Timeout." if $steps >= 100000;
print("Player 1 wins!"), exit 1 if $p1wins > $p2wins;
print("Player 2 wins!"), exit 2 if $p1wins < $p2wins;
print("Draw!"), exit 0;