File Coverage

blib/lib/Acme/URM.pm

Criterion	Covered	Total	%
statement	90	98	91.8
branch	27	34	79.4
condition	6	8	75.0
subroutine	16	18	88.8
pod	8	8	100.0
total	147	166	88.5

package Acme::URM;
use strict;
use Data::Dumper;

our $VERSION	= '0.02';

use constant	LAST		=> -1;
use constant	THIS		=> -2;
use constant	MAX_STEPS	=> -3;

my $DEBUG   = 0;
sub import {
    foreach (@_) {
        if(/^debug$/) {
            $DEBUG  = 1;
        }
    }
}

sub new {
	my $class	= shift;
	my $self	= {@_};
	$self		= bless $self, $class;
	$self->_init();
	$self
}

sub _init {
	my $self	= shift;
	$self->{registers}	= ();
	$self->{program}	= ();
	$self->{instr_num}	= 0;
	$self->{max_steps}	= -1;	# infinite
}

sub program {
	my $self	= shift;
	push @{$self->{program}}, @_	if scalar @_;
	[$self->{program}]
}

sub clear_program {
	my $self	= shift;
	$self->{program}	= ();
}

sub register {
	my $self	= shift;
	my $n		= shift || 0;
	my $i		= $n;
	foreach (@_) {
		$self->{registers}[$i++]	= $_;
	}
	(defined $self->{registers}[$n]) ? $self->{registers}[$n] : 0
}

sub clear_registers {
	my $self	= shift;
	$self->{registers}	= [];
}

sub clear {
	my $self	= shift;
	$self->clear_program();
	$self->clear_registers();
}

sub run {
	my $self	= shift;
	$self->{instr_num}	= 0;
	$self->{steps_num}	= 0;
	my $run	= 1;
	do {
		my $step	= $self->_step();
		return	$step	if MAX_STEPS == $step;
		$run		= (scalar(@{$self->{program}}) > $step) ? 1 : 0;
	} while( $run );
	_debug( "program executed",
		   "registers: " . Dumper([$self->{registers}]),
		   "",
		  );
	$self->register(0)
}

sub _check_nreg {
	my $self	= shift;
	my $nreg	= shift;
	die "invalid register index: '$nreg'\n"	if $nreg !~ /^\s*\d+\s*$/ || $nreg < 0;
}

sub _step {
	my $self	= shift;
	my $cmd		= $self->{program}[ $self->{instr_num} ];
	_debug( "running instruction $self->{instr_num}: $cmd",
		   "registers: " . Dumper($self->{registers}),
		   "",
		  );
	my $instr_num_save	= $self->{instr_num};
	if( $cmd =~ /^\s*Z\s*\((.*)\)$/i ) {
		my $nreg	= $1;
		$self->_check_nreg( $nreg );
		$self->register( $nreg, 0 );
		$self->{instr_num}++;
	} elsif( $cmd =~ /^\s*S\s*\((.*)\)$/i ) {
		my $nreg	= $1;
		$self->_check_nreg( $nreg );
		$self->register( $nreg, $self->register($nreg) + 1 );
		$self->{instr_num}++;
	} elsif( $cmd =~ /^\s*T\s*\((.*)\)$/i ) {
		my ($nreg0,$nreg1)	= split /\s*,\s*/, $1;
		$self->_check_nreg( $nreg0 );
		$self->_check_nreg( $nreg1 );
		$self->register( $nreg1, $self->register($nreg0) );
		$self->{instr_num}++;
	} elsif( $cmd =~ /^\s*J\s*\((.*)\)$/i ) {
		my ($nreg0,$nreg1,$q)	= split /\s*,\s*/, $1;
		$self->_check_nreg( $nreg0 );
		$self->_check_nreg( $nreg1 );
		if( $self->register($nreg0) == $self->register($nreg1) ) {
			if( $q == LAST ) {
				$self->{instr_num}	= scalar @{$self->{program}};
			} elsif( $q == THIS ) {
				# save instruction number
			} elsif( $q !~ /^\s*\d+\s*$/ ) {
				die "invalid instruction index: '$q'\n";
			} else {
				$self->{instr_num}	= $q;
			}
		} else {
			$self->{instr_num}++;
		}
	} else {
		die "invalid instruction: '$cmd'\n";
	}
	$self->{steps_num}++;
	if( 0 < $self->{max_steps} && $self->{max_steps} < $self->{steps_num} ) {
		return	MAX_STEPS;
	}
	_debug( "after running instruction $instr_num_save: $cmd",
		   "registers: " . Dumper($self->{registers}),
		   "",
		  );
	$self->{instr_num}
}

sub max_steps {
	my $self	= shift;
	my $val		= shift;
	$self->{max_steps}	= $val	if defined $val;
	$self->{max_steps}
}

sub _debug {
	print join("\n",@_),"\n"	if $DEBUG;
}

1;

__END__