|
996
|
1 #!/usr/bin/perl
|
|
|
2 # -*- cperl -*-
|
|
|
3 use strict;
|
|
|
4 use warnings;
|
|
|
5 use feature ":5.10";
|
|
|
6 use Fatal qw/open/;
|
|
|
7
|
|
|
8 my $debug = 0;
|
|
|
9 $/=undef;
|
|
|
10 $\="\n";
|
|
|
11 $,=" ";
|
|
|
12 my ($fh1,$fh2);
|
|
|
13 open $fh1, '<', shift;
|
|
|
14 open $fh2, '<', shift;
|
|
|
15 my $p1 = <$fh1>;
|
|
|
16 my $p2 = <$fh2>;
|
|
|
17 close $fh1;
|
|
|
18 close $fh2;
|
|
|
19 $p1 =~ y/+\-<>.[]()*0-9%{}//cd;
|
|
|
20 $p2 =~ y/+\-<>.[]()*0-9%{}//cd;
|
|
|
21 print $p1 if $debug;
|
|
|
22 print $p2 if $debug;
|
|
|
23 my $tapemaxel = int(rand(20))+10;
|
|
|
24 my @tape = (0) x ($tapemaxel+1);
|
|
|
25 my ($i1,$i2) = (0, $tapemaxel);
|
|
|
26 @tape[$i1,$i2]=(128,128);
|
|
|
27 my $steps = 0;
|
|
|
28 my ($warn1,$warn2) = (0,0);
|
|
|
29 my $bgroup = qr/(?<BGROUP>\((?:[\-+<>.*0-9%{}]|(?&BGROUP))*\))/;
|
|
|
30 while ($steps++ < 100000) {
|
|
|
31 my ($ce1,$ce2) = @tape[$i1,$i2];
|
|
|
32 last if $ce1 && $ce2 && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
|
|
|
33 {{
|
|
|
34 $p1 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
|
|
|
35 $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
|
|
|
36 $p2 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
|
|
|
37 $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
|
|
|
38 $p1 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
|
|
|
39 \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
|
|
|
40 (?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
|
|
|
41 \%(?<NUM>[0-9]+)/
|
|
|
42 $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
|
|
|
43 $p2 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
|
|
|
44 \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
|
|
|
45 (?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
|
|
|
46 \%(?<NUM>[0-9]+)/
|
|
|
47 $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
|
|
|
48 }}
|
|
|
49 $p1 = '.' if $p1 eq '';
|
|
|
50 $p2 = '.' if $p2 eq '';
|
|
|
51
|
|
|
52 given (substr ($p1,0,1,'')) {
|
|
|
53 when ('.') {}
|
|
|
54 when ('+') {$tape[$i1]++; $tape[$i1]%=256;}
|
|
|
55 when ('-') {$tape[$i1]+=255; $tape[$i1]%=256;}
|
|
|
56 when ('<') {$i1--;}
|
|
|
57 when ('>') {$i1++;}
|
|
|
58 when ('[') {
|
|
|
59 $p1 = "[$p1";
|
|
|
60 if($ce1 > 0) {
|
|
|
61 $p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
|
|
|
62 else {
|
|
|
63 $p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
|
|
|
64 default {die "$_$p1";}}
|
|
|
65 given (substr ($p2,0,1,'')) {
|
|
|
66 when ('.') {}
|
|
|
67 when ('+') {$tape[$i2]++; $tape[$i2]%=256;}
|
|
|
68 when ('-') {$tape[$i2]+=255; $tape[$i2]%=256;}
|
|
|
69 when ('<') {$i2++;}
|
|
|
70 when ('>') {$i2--;}
|
|
|
71 when ('[') {
|
|
|
72 $p2 = "[$p2";
|
|
|
73 if($ce2 > 0) {
|
|
|
74 $p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
|
|
|
75 else {
|
|
|
76 $p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
|
|
|
77 default {die "$_$p2"};}
|
|
|
78 print substr $p1,0,80 if $debug;
|
|
|
79 print substr $p2,0,80 if $debug;
|
|
|
80 print @tape if $debug;
|
|
|
81 last if $p1 eq '' && $p2 eq '';
|
|
|
82 last if $i1 < 0 || $i2 < 0 || $i1 > $tapemaxel || $i2 > $tapemaxel;
|
|
|
83 $tape[0] == 0 ? ($warn1++) : ($warn1=0);
|
|
|
84 $tape[$tapemaxel] == 0 ? ($warn2++) : ($warn2=0);
|
|
|
85 last if $warn1 == 2 || $warn2 == 2; }
|
|
|
86
|
|
|
87 my ($p1wins,$p2wins) = (0,0);
|
|
|
88 print "Both programs finished." if "$p1$p2" eq '';
|
|
|
89 print "Both programs are waiting."
|
|
|
90 if $tape[$i1] && $tape[$i2] && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
|
|
|
91 $p2wins++, print "Program 1 went off the left end." if $i1 < 0;
|
|
|
92 $p1wins++, print "Program 2 went off the right end." if $i2 < 0;
|
|
|
93 $p2wins++, print "Program 1 went off the right end." if $i1 > $tapemaxel;
|
|
|
94 $p1wins++, print "Program 2 went off the left end." if $i2 > $tapemaxel;
|
|
|
95 $p2wins++, print "Program 1's flag fell." if $warn1 == 2;
|
|
|
96 $p1wins++, print "Program 2's flag fell." if $warn2 == 2;
|
|
|
97 print "Timeout." if $steps >= 100000;
|
|
|
98 print("Player 1 wins!"), exit 1 if $p1wins > $p2wins;
|
|
|
99 print("Player 2 wins!"), exit 2 if $p1wins < $p2wins;
|
|
|
100 print("Draw!"), exit 0;
|
