view release on metacpan or  search on metacpan

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

   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

=item init()

Initialize an object instance. Clears the memory and register and sets the
memory pointer to zero. Also, the internally stored program source is
cleared.

=cut

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

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

    $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()

Copy (clone) an Acme::Cow::Interpreter object.

=cut

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

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