Acme-Cow-Interpreter

 view release on metacpan or  search on metacpan

bin/text2cow.pl  view on Meta::CPAN

print_usage,   exit if $opt_h;
print_version, exit if $opt_v;

################################################################################
## This is where the real action begins.
################################################################################

die "$PROGNAME: Too many input arguments" if @ARGV > 1;

local $/ = undef;       # file slurp mode
my $text = <>;          # get input text string

die "$PROGNAME: No input" unless defined $text;

my $n = length $text;   # get the number of characters in the string
my $prev_ord;           # this variable holds the previous ordinal value

for (my $i = 0 ; $i < $n ; ++ $i) {

    my $chr = substr($text, $i, 1);     # get this character ...

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

    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;

    $self -> {prog}     = [];            # program; array of codes
    $self -> {mem}      = [0];           # memory
    $self -> {reg}      = undef;         # register
    $self -> {prog_pos} = 0;             # index of current program code
    $self -> {mem_pos}  = 0;             # index of current memory block

    return $self;
}

=pod

=item copy()

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

      unless $selfref;

    # Check number of arguments.

    croak "$name(): Not enough input arguments" if @_ < 1;
    croak "$name(): Too many input arguments"   if @_ > 1;

    # There is no way the parser can fail. The worst thing that could happen
    # is that there are no commands in the string.

    my $string = shift; croak "$name(): Input argument is undefined"
      unless defined $string;

    # Reset, i.e., initialize, the invocand object.

    $self -> init();

    # Find the string commands, and convert them to numerical codes.

    $self -> {prog} = [
                        map { $cmd2code -> {$_} }

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

        $str .= sprintf "Memory block %6u: %12d", $i, $mem->[$i];
        if ($i == $mem_pos) {
            $str .= " <<<";
        }
        $str .= "\n";
    }

    # Print the contents of the register.

    $str .= "\n";
    $str .= sprintf "Register block: %17s", defined $reg ? $reg : '<undef>';
    $str .= "\n";

    return $str;
}

=pod

=item dump_obj()

Returns a text version of object structure.

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

    $str .= ";\n";

    $str .= '$obj -> {mem}      = [';
    $str .= join(', ', @$mem);
    $str .= "];\n";

    $str .= '$obj -> {mem_pos}  = ';
    $str .= $mem_pos;
    $str .= ";\n";
    $str .= '$obj -> {reg}      = ';
    $str .= defined $reg ? $reg : '<undef>';
    $str .= ";\n";

    return $str;
}

=pod

=item execute()

Executes the source code. The return value is the object itself.

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

            $code = $prog -> [$$prog_pos];

        }

        # Code: MMM

        elsif ($code == 9) {

            if (defined $$reg) {
                $mem -> [$$mem_pos] = $$reg;
                $$reg = undef;
            } else {
                $$reg = $mem -> [$$mem_pos];
            }

            last if $$prog_pos == $#$prog;
            $$prog_pos ++;
            $code = $prog -> [$$prog_pos];

        }

lib/Acme/Cow/Interpreter.pm  view on Meta::CPAN

            $$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 ++;

t/10-methods.t  view on Meta::CPAN

use Acme::Cow::Interpreter;

my $file = 'examples/hello.cow';

################################################################################

my $init_obj_data = {prog     => [ ],
                     prog_pos =>  0,
                     mem      => [0],
                     mem_pos  =>  0,
                     reg      => undef,
                    };

# These commands print the string "Hello, World!" followed by a newline.

my $cow_commands = <<'EOF';
MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO
MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO
MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO
MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO
Moo MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO MoO

t/10-methods.t  view on Meta::CPAN

################################################################################
# dump_obj()
################################################################################

my $expected = <<'EOF';
$obj -> {prog}     = [6, 9, 2, 9, 6, 9, 2, 9, 6, 1];
$obj -> {prog_pos} = 9;
$obj -> {mem}      = [1, 2, 3];
$obj -> {mem_pos}  = 1;
$obj -> {reg}      = <undef>;
EOF

ok(my $got = $obj -> dump_obj(),
   "dump_obj() can be invoked");

ok($got eq $expected, "dump_obj() returns the expected output");

################################################################################
# dump_mem()
################################################################################

$expected = <<'EOF';
Memory block      2:            3
Memory block      1:            2 <<<
Memory block      0:            1

Register block:           <undef>
EOF

ok($got = $obj -> dump_mem(),
   "dump_obj() can be invoked");

ok($got eq $expected, "dump_mem() returns the expected output");

################################################################################
# copy()
################################################################################