view release on metacpan or  search on metacpan

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

# -*- mode: perl; coding: us-ascii-unix; -*-

=pod

=head1 NAME

Acme::Cow::Interpreter - Cow programming language interpreter

=head1 SYNOPSIS

    use Acme::Cow::Interpreter;

    my $cow = Acme::Cow::Interpreter -> new();
    $cow -> parse_file($file);
    $cow -> execute();

=head1 ABSTRACT

This module implements an interpreter for the Cow programming language.

=head1 DESCRIPTION

This module implements an interpreter for the Cow programming language. The
Cow programming language is a so-called esoteric programming language, with
only 12 commands.

=cut

package Acme::Cow::Interpreter;

use strict;             # restrict unsafe constructs
use warnings;           # control optional warnings

use Carp;

our $VERSION = '0.02';

# This hash maps each of the 12 command (used in the source code) to the
# corresponding numerical code, from 0 to 11.

my $cmd2code =
  {
   moo =>  0,
   mOo =>  1,
   moO =>  2,
   mOO =>  3,
   Moo =>  4,
   MOo =>  5,
   MoO =>  6,
   MOO =>  7,
   OOO =>  8,
   MMM =>  9,
   OOM => 10,
   oom => 11,
  };

# This array maps each of the 12 numerical codes to the corresponding
# command (used in source code).

my $code2cmd =
  [
   'moo',
   'mOo',
   'moO',
   'mOO',
   'Moo',
   'MOo',
   'MoO',
   'MOO',
   'OOO',
   'MMM',
   'OOM',
   'oom',
  ];

# This regular expression matches all the 12 valid commands.

my $cmd_regex = '(?:[Mm][Oo][Oo]|MMM|OO[MO]|oom)';

=pod

=head1 METHODS

=over 4

=item new()

Return a new Cow interpreter.

=cut

sub new {
    my $proto    = shift;
    my $protoref = ref $proto;
    my $class    = $protoref || $proto;
    my $name     = 'new';

    # Check how the method is called.

    croak "$name() is a class method, not an instance/object method"
      if $protoref;

    # The new self.

    my $self = {};

    # Bless the reference into an object.

    bless $self, $class;

    # Initialize it.  The return value of init() is the object itself.

    $self -> init();
}

=pod

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

      unless $selfref;

    # Check number of arguments.

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

    my $copy = {};
    for my $key (keys %$self) {
        my $ref = ref $self -> {$key};
        if ($ref eq 'ARRAY') {
            @{ $copy -> {$key} } = @{ $self -> {$key} };
        } else {
            $copy -> {$key} = $self -> {$key};
        }
    }

    # Bless the copy into an object.

    bless $copy, $class;
}

=pod

=item parse_string( STRING )

Parses the given string and stores the resulting list of codes in the
object.  The return value is the object itself.

=cut

sub parse_string {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;
    my $name    = 'parse_string';

    # 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 @_ < 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 -> {$_} }
                          $string =~ /($cmd_regex)/go
                      ];

    return $self;
}

=pod

=item parse_file( FILENAME )

Parses the contents of the given file and stores the resulting list of codes
in the object. The return value is the object itself.

=cut

sub parse_file {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;
    my $name    = 'parse_file';

    # 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 @_ < 1;
    croak "$name(): Too many input arguments"   if @_ > 1;

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

    $self -> init();

    # Get the file name argument.

    my $file = shift;

    open FILE, $file or croak "$file: can't open file for reading: $!";

    # Iterate over each line, find the string commands, and convert them to
    # numerical codes.

    while (<FILE>) {
        push @{ $self -> {prog} },
          map { $cmd2code -> {$_} }
            /($cmd_regex)/go;
    }

    close FILE or croak "$file: can't close file after reading: $!";

    return $self;
}

=pod

=item dump_mem()

Returns a nicely formatted string showing the current memory state.

=cut

sub dump_mem {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;
    my $name    = 'dump_mem';

    # 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;

    my $mem     = $self -> {mem};
    my $mem_pos = $self -> {mem_pos};
    my $reg     = $self -> {reg};

    my $str = '';

    # Print the contents of the memory, showing the block which the memory
    # points at.

    for (my $i = $#$mem ; $i >= 0 ; -- $i) {
        $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