AoC 2016 day 23

#!/usr/bin/env perl6

use v6.c;

class Computer
{
    has @.instructions;
    has @.optimized;
    has @.code;
    has Int $.pos = 0;
    has Int $.counter = 0;
    has %.register = :a(0), :b(0), :c(0), :d(0);
    has Bool $.verbose = False;

    constant %TOGGLE = { :inc<dec>, :dec<inc>, :tgl<inc>, :jnz<cpy>, :cpy<jnz> };

    method compile-line($pos)
    {
        my token reg { <[abcd]> };
        my token val { '-'? \d+ }

        @!optimized[$pos] = '';

        given @!instructions[$pos] {
            when m:s/^ cpy <val> <reg> $/ {
                my $val = +$<val>;
                my $reg = ~$<reg>;
                return { %!register{$reg} = $val };
            }
            when m:s/^ cpy <reg> <reg> $/ {
                my $regFrom = ~$<reg>[0];
                my $regTo = ~$<reg>[1];
                return { %!register{$regTo} = %!register{$regFrom} };
            }
            when m:s/^ inc <reg> $/ {
                my $reg = ~$<reg>;

                # See if we can optimize away a loop
                if $pos < +@!instructions - 2 && @!instructions[$pos+1] ~~ m:s/^ dec <reg> $/ {
                    my $reg2 = ~$<reg>;
                    if $reg2 ne $reg && @!instructions[$pos+2] ~~ m:s/^ jnz $reg2 '-2' $/ {
                        if $pos < +@!instructions - 4 && @!instructions[$pos+3] ~~ m:s/^ dec <reg> $/ {
                            my $reg3 = ~$<reg>;
                            if $reg3 ne $reg|$reg2 && @!instructions[$pos+4] ~~ m:s/^ jnz $reg3 '-5' $/ {
                                # Multiplication
                                @!optimized[$pos] = "$reg += $reg2 * $reg3; $reg2 = $reg3 = 0";
                                return { %!register{$reg} += %!register{$reg2} * %!register{$reg3};
                                         %!register{$reg2} = 0;
                                         %!register{$reg3} = 0;
                                         $!pos = $pos+5; };
                            }
                        }

                        # Addition
                        @!optimized[$pos] = "$reg += $reg2; $reg2 = 0";
                        return { %!register{$reg} += %!register{$reg2};
                                 %!register{$reg2} = 0;
                                 $!pos = $pos+3; }
                    }
                }

                # Unoptimized increment
                return { %!register{$reg}++ };
            }
            when m:s/^ dec <reg> $/ {
                my $reg = ~$<reg>;

                # See if we can optimize away a loop
                if $pos < +@!instructions - 2 && @!instructions[$pos+1] ~~ m:s/^ inc <reg> $/ {
                    my $reg2 = ~$<reg>;
                    if $reg2 ne $reg && @!instructions[$pos+2] ~~ m:s/^ jnz $reg '-2' $/ {
                        if $pos < +@!instructions - 4 && @!instructions[$pos+3] ~~ m:s/^ dec <reg> $/ {
                            my $reg3 = ~$<reg>;
                            if $reg3 ne $reg|$reg2 && @!instructions[$pos+4] ~~ m:s/^ jnz $reg3 '-5' $/ {
                                # Multiplication
                                @!optimized[$pos] = "$reg2 += $reg * $reg3; $reg = $reg3 = 0";
                                return { %!register{$reg2} += %!register{$reg} * %!register{$reg3};
                                         %!register{$reg} = 0;
                                         %!register{$reg3} = 0;
                                         $!pos = $pos+5; };
                            }
                        }

                        # Addition
                        @!optimized[$pos] = "$reg2 += $reg; $reg = 0";
                        return { %!register{$reg2} += %!register{$reg};
                                 %!register{$reg} = 0;
                                 $!pos = $pos+3;}
                    }
                }

                # Unoptimized decrement
                return { %!register{$reg}-- };
            }
            when m:s/^ jnz <nonzero=val> <offset=val> $/ {
                my $nonzero = +$<nonzero>;
                my $offset = $<offset>;
                return { $!pos = $pos + $offset if $nonzero };
            }
            when m:s/^ jnz <nonzero=reg> <offset=val> $/ {
                my $nonzero = ~$<nonzero>;
                my $offset = $<offset>;
                return { $!pos = $pos + $offset if %!register{$nonzero} };
            }
            when m:s/^ jnz <nonzero=val> <offset=reg> $/ {
                my $nonzero = +$<nonzero>;
                my $offset = $<offset>;
                return { $!pos = $pos + %!register{$offset} if $nonzero };
            }
            when m:s/^ jnz <nonzero=reg> <offset=reg> $/ {
                my $nonzero = ~$<nonzero>;
                my $offset = $<offset>;
                return { $!pos = $pos + %!register{$offset} if %!register{$nonzero} };
            }
            when m:s/^ tgl <val> $/ {
                my $val = $<val>;
                return { self.toggle($pos+$val) };
            }
            when m:s/^ tgl <reg> $/ {
                my $reg = ~$<reg>;
                return { self.toggle($pos+%!register{$reg}) };
            }
            default {
                die "Invalid instruction: $_";
            }
        }
    }

    method compile()
    {
        say "Compiling..." if $!verbose;

        @!code = gather for 0..^@!instructions -> $pos {
            take self.compile-line($pos);
        }
    }

    method toggle(Int $pos)
    {
        return unless @!instructions[$pos];

        my ($instr, $args) = @!instructions[$pos].split(' ', 2);
        die "Don't know how to toggle '$instr'" unless %TOGGLE{$instr};
        @!instructions[$pos] = "%TOGGLE{$instr} $args";

        # We need to recompile the whole program, since the code may have been part of a
        # loop that was optimized away.
        self.compile();
    }

    method run()
    {
        self.compile unless @!code;

        while @!code[$!pos] {
            $!counter++;
            say "$!pos: (%!register<a b c d>.join(' ')) ",
                            @!optimized[$!pos] ?? "@!optimized[$!pos] [optimized]"
                                               !! @!instructions[$!pos] if $!verbose;
            @!code[$!pos++]();
        }
    }
}

sub MAIN(IO() $inputfile where *.f, Int :$a=12, Int :$b=0, Int :$c=0, Int :$d=0, Bool :v(:$verbose))
{
    my $computer = Computer.new(:instructions($inputfile.lines), :$verbose);
    $computer.register<a b c d> = $a, $b, $c, $d;
    $computer.run;

    say '' if $verbose;
    say "The state of the register: ",
         $computer.register.pairs.sort.map({ "$_.key()=$_.value()"}).join(', ');
    say "$computer.counter() instructions processed.";
}