# New Ticket Created by Peter Schwenn
# Please include the string: [perl #63780]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=63780 >
(Please feel free to move this to perl6-users if you feel that more
appropriate.)
The code below gives the interaction:
(Seeming to suggest some fault in the Class/Object handling; but of
course COULD be a simple programming misconception/bug)
C:\parrot>perl6 /peter/perlprograms/lilcalc.p6
8 [ 8 key struck ]
Read token 8
pushed 8 to @items 8 at depth 0 [ ok so far ]
3 [ 3 key struck ]
Read token 3
pushed 3 to @items 3 3 at depth 1 [ @items should be 8 3 not 3 3 ]
* [ * key struck ]
Read token *
popping from @items * * at depth 1 , [ similarly, @items should be 8 3 not * *]
the item: *
popping from @items * * at depth 0 ,
the item: *
....
This program works properly if I code the pushing and popping of
@items inline - no Classes/Objects. And it fails in the same way if I
use the forms "@items.pop" and "@items.push" instead of the form
"@items[$depth]" .
--------------------------------------------------------------------start
code---------------------------------------------------
#!perl6
class OpStack
{
has Int $depth= -1;
has @items;
method popp {
my $popd;
say "popping from \...@items {...@items[]} at depth $depth ,";
$popd= @items[$depth--]; # " [email protected]" fails in same way]
say " the item: $popd \n";
return $popd;
}
method pushh($arhg) {
@items[++$depth]= $arhg;
say "pushed $arhg to \...@items {...@items[]} at depth $depth \n";
}
}
class Tokens { #no particular reason (yet) why Tokens is a Class
method next {
my $Toke= =$*IN;
say "Read token $Toke\n";
return $Toke;
}
}
sub calc()
{
my Tokens $Token .= new;
my OpStack $Stack .= new;
my $first;
my $second;
my $answer;
my $tok;
my $toktype;
loop {
$tok= $Token.next;
$toktype= lex($tok);
given $toktype {
when /arg/ { $Stack.pushh($tok); }
when /op$|opbinary/ {
$second= $Stack.popp;
$first= $Stack.popp;
$answer= eval ($first, $tok, $second);
say "$first $tok $second = $answer\n";
$Stack.pushh($answer); }
default { say "err\n"; } #later: single arg ops
} # given
} # loop forever
} # calc
calc;
exit 1;
sub lex ($token)
{
given $token {
when / <[A..Z]> (\d) / {return $0;} ###operation not defined yet
when / <[0..9\.]>+ / {return "arg";}
when / <[+\-]>? \d+ .? \d? <[ED]>? <[+\-]>? \d? / {return "arg";}
#could be a better regex
when / <[+\-*/^%]> / {return "opbinary";}
when / (push|pop) / {return "memop";}
### need logic for opunary (which could be e.g. error code on $second=
...pop [only $first was there])
default {return "err";}
}
}
-----------------------------------------------end code
-------------------------------------------------------------------------------------------------------------
