AoC 2024, day 17 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say);
use List::Util      qw(min);

# Read input:
$/ = '';
my @section = map {[split /\n/]} <>;
my @reg  = map {m#(\d+)#g} $section[0]->@*;
my @code = map {m#(\d+)#g} $section[1][0];

# Define machine:
use constant  A => 0;
use constant  B => 1;
use constant  C => 2;

my $ip = 0;
my @out;

# combo operator redirection:
sub c_op ($)   {my $op = shift; return (($op & 04) ? $reg[$op & ~04] : $op)}

my @op_str = ('adv', 'bxl', 'bst', 'jnz', 'bxc', 'out', 'bdv', 'cdv');
my %opcodes =
    (
        0 => sub {my $op = c_op shift; $reg[A] = $reg[A] >> $op},           # adv
        6 => sub {my $op = c_op shift; $reg[B] = $reg[A] >> $op},           # bdv
        7 => sub {my $op = c_op shift; $reg[C] = $reg[A] >> $op},           # cdv

        1 => sub {my $op = shift;      $reg[B] ^= $op},                     # bxl
        4 => sub {my $op = shift;      $reg[B] ^= $reg[C]},                 # bxc

        2 => sub {my $op = c_op shift; $reg[B] = $op % 8},                  # bst
        5 => sub {my $op = c_op shift; push(@out, $op % 8)},                # out

        3 => sub {my $op = shift;      $ip = ($reg[A]) ? $op - 2 : $ip},    # jnz
    );

# Part 1:
# Run machine:
while ($ip < @code - 1) {
    &{$opcodes{$code[$ip]}}( $code[$ip+1] );
    $ip += 2;
}

say "Part 1: ", join(',', @out);

# Part 2:
# Run code until jump.
sub try_code {
    # Reset machine with argument in A register:
    @reg = (shift, 0, 0);
    @out = ();
    $ip = 0;

    while ($ip < @code - 1 && $code[$ip] != 3) {    # halt on jnz (or end)
        &{$opcodes{$code[$ip]}}( $code[$ip+1] );
        $ip += 2;
    }

    return ($out[0]);
}

# ASSUME:
# - Code is deconstructed A by shifting it in a loop (true of input and test 2).
# - The loop outputs one value each time.
# - Higher order bits of A will be involved in the calculation for the input.

# So we go in reverse because the we know what the high bits can possibly be while testing.
# We may get multiple octal digits that can solve the partial that we need to track.
my %poss = (0 => 1);
foreach my $digit (reverse @code) {
    my %new_poss;

    # shift left possibilities one octal digit and try all 8 lower options
    foreach my $val (map {($_<<3) .. ($_<<3) + 7} keys %poss) {
        if ($digit == &try_code( $val )) {
            $new_poss{$val}++;
        }
    }
    %poss = %new_poss;
}

say "Part 2: ", min keys %poss;