sub follow_paths {
my ($x_s,$y_s,$s_s,$paths,$regs) = @_;
my $branches = $paths->[$x_s][$y_s][$s_s];
unless (defined $branches) {
# pad endpoint (base case)}
return [[[$x_s,$y_s,$s_s,'pad']]];
}
if (exists $regs->{$x_s}{$y_s}{$s_s}) {
# register endpoint (base case)
return [[[$x_s,$y_s,$s_s,'reg']]];
}
my @current;
foreach my $branch (@$branches) {
my $branch_paths = follow_paths(@$branch,$paths,$regs);
push @current, map { unshift @$_, [$x_s,$y_s,$s_s]; $_ }
@$branch_paths;
}
return \@current;
}
####
regs =
1,0,0
paths =
0,0,0 =>
3,0,0
0,1,0 =>
0,2,0
1,0,0 =>
0,3,0
3,0,0 =>
0,1,0
1,0,0
##
##
[[3,0,0]
[0,1,0]
[0,2,0,'pad']
],
[[3,0,0]
[1,0,0,'reg']
]
##
##
sub follow_paths_unrolled {
my ($x_s,$y_s,$s_s,$paths,$regs) = @_;
my $cur_x = $x_s;
my $cur_y = $y_s;
my $cur_s = $s_s;
my $index = 0;
my $current = [];
my @STACK;
my $RETURN;
my $BRANCH = 0;
NEWCALL:
while(1) {
my $branches = $paths->[$cur_x][$cur_y][$cur_s];
if (not defined $branches) {
# pad endpoint (base case)}
$RETURN = [[[$x_s,$y_s,$s_s,'pad']]];
}
elsif (exists $regs->{$x_s}{$y_s}{$s_s}) {
# register endpoint (base case)
$RETURN = [[[$x_s,$y_s,$s_s,'reg']]];
}
else {
for (my $i=$index; $i < @$branches; $i++) {
if ($BRANCH == 0) {
my $branch = $branches->[$i];
# push @STACK
$BRANCH = 1;
push @STACK, [$cur_x,$cur_y,$cur_s,$i,$current,$BRANCH];
# set new values
($cur_x,$cur_y,$cur_s) = @$branch;
$index = 0;
$current = [];
$BRANCH = 0;
next NEWCALL;
}
else {
my $branch_paths = $RETURN;
push @$current, map { unshift @$_, [$cur_x,$cur_y,$cur_s]; $_ }
@$branch_paths;
$BRANCH = 0;
}
}
$RETURN = $current;
}
return $RETURN unless @STACK;
($cur_x,$cur_y,$cur_s,$index,$current,$BRANCH) = @{pop @STACK};
}
}