Acme-Cow-Interpreter
view release on metacpan or search on metacpan
lib/Acme/Cow/Interpreter.pm view on Meta::CPAN
Executes the source code. The return value is the object itself.
=cut
sub execute {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
my $name = 'execute';
# Check how the method is called.
croak "$name() is an instance/object method, not a class method"
unless $selfref;
# Check number of arguments.
#croak "$name(): Not enough input arguments" if @_ < 0;
croak "$name(): Too many input arguments" if @_ > 0;
# These variables are merely for convenience. They make the code below a
# bit cleaner.
my $prog = $self -> {prog};
my $mem = $self -> {mem};
my $prog_pos = \$self -> {prog_pos};
my $mem_pos = \$self -> {mem_pos};
my $reg = \$self -> {reg};
# Quick exit if there are no commands (program is void).
return 1 unless @$prog;
# The code to be executed.
my $code = $prog -> [$$prog_pos];
# Main loop. Each round executes one instruction.
{
#print "-" x 72, "\n";
#print "prog ...:";
#printf " %3s", $code2cmd -> [$_] for @$prog;
#print "\n";
#print "ppos ...:", " " x $$prog_pos, " ^^^\n";
##print "ppos ...: $$prog_pos\n";
#print "code ...: $code ($code2cmd -> [$code])\n";
#print "\n";
#print "mem ....:";
#printf " %4d", $_ for @$mem;
#print "\n";
#print "mpos ...:", " " x $$mem_pos, " ^^^^\n";
#print "reg ....: ", defined $$reg ? $$reg : "", "\n";
#<STDIN>;
# Code: moo
if ($code == 0) {
# Remember where we started searching for matching 'MOO'.
my $init_pos = $$prog_pos;
# Skip previous instruction when looking for matching 'MOO'.
$$prog_pos --;
my $level = 1;
while ($level > 0) {
if ($$prog_pos == 0) {
croak "No previous 'MOO' command matching 'moo'",
" command. Failed at instruction number $init_pos.";
#last;
#return 0;
}
$$prog_pos --;
if ($prog -> [$$prog_pos] == 0) { # if "moo"
$level ++;
} elsif ($prog -> [$$prog_pos] == 7) { # if "MOO"
$level --;
}
}
# This if-test is necessary if we use 'last' rather than 'croak'
# in the if-test inside the while-loop above.
#
#if ($level != 0) {
# croak "No previous 'MOO' command matching 'moo'",
# " command (instruction number $init_pos).";
#}
$code = $prog -> [$$prog_pos];
}
# Code: mOo
elsif ($code == 1) {
if ($$mem_pos == 0) {
croak "Can't move memory pointer behind memory block 0.",
" Failed at command number $$prog_pos.";
}
$$mem_pos --;
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# Code: moO
elsif ($code == 2) {
$$mem_pos ++;
if ($$mem_pos > $#$mem) {
lib/Acme/Cow/Interpreter.pm view on Meta::CPAN
croak "Invalid instruction at this point (would cause",
" infinite loop). Failed at instruction number $$prog_pos.";
}
# We don't need to check for any other invalid instruction
# (which exits the program), since this will be taken care of in
# the next round.
$code = $mem -> [$$mem_pos];
}
# Code: Moo
elsif ($code == 4) {
if ($mem -> [$$mem_pos] == 0) {
my $chr;
read(STDIN, $chr, 1);
$mem -> [$$mem_pos] = ord($chr);
} else {
printf "%c", $mem -> [$$mem_pos];
}
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# Code: MOo
elsif ($code == 5) {
$mem -> [$$mem_pos] --;
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# Code: MoO
elsif ($code == 6) {
$mem -> [$$mem_pos] ++;
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# Code: MOO
elsif ($code == 7) {
if ($mem -> [$$mem_pos] == 0) {
# Remember where we started searching for matching 'moo'.
my $init_pos = $$prog_pos;
# Skip next instruction when looking for matching 'moo'.
$$prog_pos ++;
my $level = 1;
my $prev_code;
while ($level > 0) {
if ($$prog_pos == $#$prog) {
croak "No following 'moo' command matching 'MOO'",
" command. Failed at instruction number $init_pos.";
}
$prev_code = $prog -> [$$prog_pos];
$$prog_pos ++;
if ($prog -> [$$prog_pos] == 7) { # if "MOO"
$level ++;
} elsif ($prog -> [$$prog_pos] == 0) { # if "moo"
$level --;
if ($prev_code == 7) {
$level --;
}
}
}
# This if-test is necessary if we use 'last' rather than
# 'croak' in the if-test inside the while-loop above.
#
#if ($level != 0 ) {
# croak "No following 'moo' command matching 'MOO'",
# " command. Failed at instruction number $init_pos.";
#}
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
} else {
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
}
# Code: OOO
elsif ($code == 8) {
$mem -> [$$mem_pos] = 0;
last if $$prog_pos == $#$prog;
$$prog_pos ++;
lib/Acme/Cow/Interpreter.pm view on Meta::CPAN
elsif ($code == 10) {
printf "%d\n", $mem -> [$$mem_pos];
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# Code: oom
elsif ($code == 11) {
my $input = <STDIN>;
croak "Input was undefined\n"
unless defined $input;
$input =~ s/^\s+//;
$input =~ s/\s+$//;
croak "Input was not an integer -- $input\n"
unless $input =~ /^[+-]?\d+/;
$mem -> [$$mem_pos] = $input;
last if $$prog_pos == $#$prog;
$$prog_pos ++;
$code = $prog -> [$$prog_pos];
}
# An invalid instruction exits the running program.
else {
return 1;
}
redo;
}
return $self;
}
=pod
=back
=head1 NOTES
=head2 The Cow Language
The Cow language has 12 instruction. The commands and their corresponding
code numbers are:
=over 4
=item moo (0)
This command is connected to the B<MOO> command. When encountered during
normal execution, it searches the program code in reverse looking for a
matching B<MOO> command and begins executing again starting from the found
B<MOO> command. When searching, it skips the command that is immediately
before it (see B<MOO>).
=item mOo (1)
Moves current memory position back one block.
=item moO (2)
Moves current memory position forward one block.
=item mOO (3)
Execute value in current memory block as if it were an instruction. The
command executed is based on the instruction code value (for example, if the
current memory block contains a 2, then the B<moO> command is executed). An
invalid command exits the running program. Value 3 is invalid as it would
cause an infinite loop.
=item Moo (4)
If current memory block has a 0 in it, read a single ASCII character from
the standard input and store it in the current memory block. If the current
memory block is not 0, then print the ASCII character that corresponds to
the value in the current memory block to the standard output.
=item MOo (5)
Decrement current memory block value by 1.
=item MoO (6)
Increment current memory block value by 1.
=item MOO (7)
If current memory block value is 0, skip next command and resume execution
after the next matching B<moo> command. If current memory block value is not
0, then continue with next command. Note that the fact that it skips the
command immediately following it has interesting ramifications for where the
matching B<moo> command really is. For example, the following will match the
second and not the first B<moo>: B<OOO> B<MOO> B<moo> B<moo>
=item OOO (8)
Set current memory block value to 0.
=item MMM (9)
If no current value in register, copy current memory block value. If there
is a value in the register, then paste that value into the current memory
block and clear the register.
=item OOM (10)
Print value of current memory block to the standard output as an integer.
=item oom (11)
Read an integer from the standard input and put it into the current memory
( run in 1.033 second using v1.01-cache-2.11-cpan-5a3173703d6 )