#!/usr/bin/perl
# line 1 char 4: word*
# line 1 char 5: word*;*
# line 1 char 5: command*
# line 1 char 6: command*
# line 1 char 10: command*word*
# line 1 char 11: command*word*;*
# line 1 char 11: command*command*
# line 1 char 11: commandset*
# line 1 char 12: commandset*
# line 1 char 16: commandset*word*
# line 1 char 17: commandset*word*;*
# line 1 char 17: commandset*command*
# line 1 char 17: commandset*
# line 1 char 18: commandset*
# line 1 char 21: commandset*word*
# line 1 char 22: commandset*word*
# line 1 char 25: commandset*word*quote*
# line 1 char 26: commandset*word*quote*;*
# line 1 char 26: commandset*command*
# line 1 char 26: commandset*
# line 1 char 27: commandset*
# line 1 char 32: commandset*word*
# line 1 char 33: commandset*word*;*
# line 1 char 33: commandset*command*
# line 1 char 33: commandset*

use strict;
use autodie;
#use warnings;

  # create the virtual machine object code and save it
  # somewhere on the tape.

  # code generated by "translate.perl.pss" a pep script
  # see http://bumble.sf.net/books/pars/tr/

package Machine;
  my $true = 1;
  my $false = 0;

  sub new {
    my $class = shift;  # 

    my $self = {
      # output =>    # A reference to the output and input streams
      # input =>     # if <stdin> and <stdout> are not used.
      input => *STDIN,
      output => *STDOUT,
      size => 300,      # how many initial elements in tape/marks array
      eof => 0,         # end of stream reached?
      charsRead => 0,   # how many chars already read
      linesRead => 1,   # how many lines already read
      escape => "\\",
      delimiter => "*", # push/pop delimiter (default "*")
      counter => 0,     # a counter for anything
      work => "",       # the workspace
      stack => (),      # stack for parse tokens 
      cell => 0,                # current tape cell
      tape => (),       # a list of attribute for tokens 
      marks => (),      # marked tape cells 
      peep => "" 
    };


    #$self->{"tape"} = 100;
    #$self->{"marks"} = 100;
    #@{$self->{"tape"}} = ("") x 100;
    #@{$self->{"marks"}} = ("") x 100;
    #$self->{"size"} = 100;
    # or use this, which may not duplicate the references
    # $my @arr = map { [] } 1..100;

    bless $self, $class;
    return $self;
  }

  # if (@tape < 5) check if length of tape is 4 or less
  sub setInput {
    my $self = shift;   # pointer to the machine
    my $newInput = shift; 
    print "to be implemented";
  }

  # read one character from the input stream and 
  #    update the machine.
  sub readChar {
    #$self->{"peep"} = getc(STDIN);

    my $self = shift;   # the pep/nom virtual-machine object
    if ($self->{"eof"}) { exit; }
    $self->{"charsRead"} += 1;
    # increment auto line counter
    if ($self->{"peep"} eq "\n") { $self->{"linesRead"} += 1; }
    $self->{"work"} .= $self->{"peep"};
    $self->{"peep"} = getc($self->{"input"});
    #check
    if (eof($self->{"input"})) { $self->{"eof"} = 1; }
  }

  # test if all chars in workspace are in unicode category
  sub isInCategory {
    my $self = shift;   # pointer to the machine
    my $cat = shift; 
    #for ch in $self->{"work"}
    #  if not category(ch).start_with?(cat) then return false end
    #return True
  }

  # this walks the string and determines if the given char 
  # is already escaped or not # eg "abcab\cabc"
  sub unescapeChar {
    my $self = shift;   # the machine
    my $c = shift;
    my $cc = "";
    my $result = "";
    my $isEscaped = $false;

    foreach $cc (split(//,$self->{"work"})) {
      if (($isEscaped == $false) && ($cc eq $self->{"escape"})) {
        $isEscaped = $true;
      } else { $isEscaped = $false; }
      # remove the last escape character (usually backslash)
      if (($isEscaped == $true) && ($cc eq $c)) {
        $result =~ s/.$//s; 
      }
      $result .= $cc; 
    }
    $self->{"work"} = $result;
  }

  # this needs to walk the string and determine if the given char 
  # is already escaped or not # eg "abcab\cabc"
  sub escapeChar {
    my $self = shift;   # the machine
    my $c = shift;
    my $cc = "";
    my $result = "";
    my $isEscaped = $false;

    foreach $cc (split(//,$self->{"work"})) {
      if (($isEscaped == $false) && ($cc eq $self->{"escape"})) {
        $isEscaped = $true;
      } else { $isEscaped = $false; }
      if (($isEscaped == $true) && ($cc eq $c)) {
        $result .= $self->{"escape"};
      }
      $result .= $cc; 
    }
    $self->{"work"} = $result;
  }

  # a helper for the multiescape until bug
  sub countEscaped {
    my $self = shift;   # the machine
    my $suffix = shift; 
    my $count = 0;
    # no check
    my $s = $self->{"work"};
    $s =~ s/$suffix$//;
    while ($s =~ /$self->{"escape"}$/) {
      $count += 1;
      $s =~ s/$self->{"escape"}$//;
    }
    return $count;
  }

  # reads the input stream until the workspace end with text 
  sub until {
    my $self = shift;   # the machine
    my $suffix = shift; 
    # read at least one character
    if ($self->{"eof"}) { return; }
    # pass a reference to the machine hash with % not %
    $self->readChar();
    while (1) { 
      if ($self->{"eof"}) { return; }
      # need to count the @escape chars preceding suffix
      # if odd, keep reading, if even, stop
      if ($self->{"work"} =~ /Q$suffix$/) { 
        if ($self->countEscaped($suffix) % 2 == 0) { return; }
      }
      $self->readChar()
    }
  }  

  # this implements the ++ command incrementing the tape pointer
  # and growing the tape and marks arrays if required
  sub increment {
    my $self = shift;   # the machine
    $self->{"cell"} += 1;
    if ($self->{"cell"} >= $self->{"tape"}) { 
      # lengthen the tape and marks arrays by assigning to
      # length var
      $self->{"tape"} = $self->{"tape"} + 40;
      $self->{"marks"} = $self->{"marks"} + 40;
      $self->{"size"} = $self->{"tape"};
    }
  }

  # pop the first token from the stack into the workspace */
  sub popToken {
    my $self = shift;   # the machine, not local
    if (!$self->{"stack"}) { return 0; }
    $self->{"work"} = pop(@{$self->{"stack"}}) + $self->{"work"};
    if ($self->{"cell"} > 0) { $self->{"cell"} -= 1; }
    return 1;
  }

  # push the first token from the workspace to the stack 
  sub pushToken {
    my $self = shift;   # a pointer to the machine
    # dont increment the tape pointer on an empty push
    if ($self->{"work"} eq "") { return 0; }
    # need to get this from the delimiter.
    my $iFirst = index($self->{"work"}, $self->{"delimiter"});
    if ($iFirst == -1 ) {
      push(@{$self->{"stack"}}, $self->{"work"}); 
      $self->{"work"} = ""; return 1;
    }
    # s[i..j] means all chars from i to j
    # s[i,n] means n chars from i
    push(@{$self->{"stack"}}, substr($self->{"work"}, 0, $iFirst));
    $self->{"work"} = substr($self->{"work"}, $iFirst+1, -1);
    $self->increment();
    return 1;
  }

  sub printState {
    # print "Stack[${@self->{\   # print "Acc:#{$self->{"counter"}} Esc:#{$self->{"escape"}} Delim:#{$self->{"delimiter"}} Chars:#{$self->{"charsRead"}}" +
   #      " Lines:#{$self->{"linesRead"}} Cell:#{$self->{"cell"}}"
  }

  sub goToMark {
    my $self = shift;   # a pointer to the machine
    my $mark = shift; 
    # search the marks 
    for my $ii (0..$self->{"marks"}) {
      if (@{$self->{"marks"}}[$ii] eq $mark) {
        $self->{"cell"} = $ii; 
        return;
      }
    }
    # mark was not found- fatal error!
    print("bad mark '$mark!'");
    exit();
  }

  # parses from a string and returns the result as a string.
  # useful for programatic use. Chopping last char??
  # does nothing if no input given.
  sub parseString {
    my $out = "";
    my $self = shift;       # the parse machine 
    my $in = shift;         # input string
    if (!defined $in) { return ""; }
    open my $input, "<", \$in or return "[no input!]";
    open my $output, ">", \$out or return "[no output!]";
    $self->parse($input, $output);
    return $out;
  }

  # parses from a file and writes to a string
  # useful for creating a pep/nom interpreter.
  sub parseFile {
    my $out = "";
    my $self = shift;          # the parse machine 
    my $infile = shift;         # input filename
    if (!defined $infile) { return ""; }
    open my $input, "<", $infile or return "[no input file!]";
    open my $output, ">", \$out or return "[no output!]";
    $self->parse($input, $output);
    return $out;
  }

  # This function performs all sorts of magic and shenanigans. 
  # Creates a new method runScript() and evaluates it, 
  # thus acting as an interpreter of a scriptfile given to an
  # -f switch. This method only works when the perl translator has 
  # been run on itself with:
  #   >> pep -f translate.perl.pss translate.perl.pss > interp.pl.pl
  #   >> echo "read; print; print; clear; " > test.pss
  #   >> chmod a+x interp.pl.pl
  #   >> echo buzz | ./interp.pl.pl -f test.pss
  #   >> (output should be "bbuuzz")
  # Only those who have achieved
  # true enlightenment will understand this method.

  sub interpret {
    my $self = shift;          # the parse machine 
    my $filename = "";
    if ($ARGV[0] eq "-f") { $filename = $ARGV[1]; }
    if ($ARGV[0] =~ /^-f/) { 
      $filename = $ARGV[1]; $filename =~ s/^..//;
    }
    if ((!defined $filename) || ($filename eq "")) { return; }
    my $method = $self->parseFile($filename);
    # remove everything except the parse method and rename
    $method =~ s/^.*sub parse \{/sub runScript \{/s;
    # to debug
    # print $method; return;
    # add this new method to the current class via evaluation
    eval($method);
    # execute the new method, thus interpreting the script-file 
    # that was provide
    $self->runScript(*STDIN, *STDOUT);
  }



  # This could have an input/output stream argument, or make the 
  # streams an attribute of the object.
  sub parse {
    my $self = shift;  # a machine reference
    my $in = shift;   # the input stream
    my $out = shift;  # output stream
    if (!defined $in) { $in = *STDIN; }
    if (!defined $out) { $out = *STDOUT; }
    #$self->{"output"} = *STDOUT;
    $self->{"output"} = $out;
    $self->{"input"} = $in;
    $self->{"peep"} = getc($self->{"input"});
    # the restart flag allows .restart to work before the 
    # parse label, in languages that dont have labelled loops
    my $restart = $false; 

    while (!$self->{"eof"}) {
    
      $self->readChar();         # read
      $self->readChar();         # read
      $self->readChar();         # read
      $self->{'work'} .= :;
      $self->{"output"}->print($self->{"work"});   # print
    }
    
  }
  # end of Machine methods definition

  my $mm = Machine->new();

  # reads from <stdin> and writes to <stdout>
  $mm->parse();

  # --------
  # Other ways to call parse(), parseString() and parseFile()
  # Use an input file and print to stdout.
  # open IN, "<pars-book.txt" or die $!;
  # $mm->parse(*IN);

  # write results to an output file, reading from stdin
  # open OUT, ">test.txt" or die $!;
  # $mm->parse(*STDIN, *OUT);

  # parse/translate a string and return the result as string
  # my $result = $mm->parseString("new.new");
  # print $result;

  # parse/translate a file and return the result as a string
  # my $result = $mm->parseFile("test.txt");
  # print $result;

  # end of generated perl code
