Here is something fun. Let’s make a full RPN calculator in Perl 6. In the process we’ll learn a lot about Perl 6′s cool grammar features.
Regexes on steroids
Perl 6 extends Perl 5′s regular expressions to make a full grammar language. Btw, we no longer say “regular expression”, we just say “regex”. The first feature I’ll introduce is the token. A token is basically a regex with a name so you can refer to it later. For example:
token Op {'/' || '*' || '+' || '-'};
token Value { \d+[\.\d+]? };
The first token matches the arithmetic operators + – * /. The second token matches numeric values. You can use these tokens inside a regex. For example, the following matches one or more Ops:
$str ~~ / <Op> + /
Changes compared to Perl 5:
- Space is not significant in a P6 regex. You can space things out to make the regex more readable.
- If you put single quotes around any text, the regex matches that text literally. So instead of writing \* you can write ‘*’
- Now we use ~~ instead of =~
An RPN grammar
We can write tokens that refer to other tokens in order to build more complex grammars. A RPN calculator is basically a list of values and operators. Thus, we can complete the RPN grammar with:
# An "item" is either a value or an operator. token Item { <Value> || <Op> }; # An "expression" is one or more items separated by white space. token Expr { [<ws> <Item> <ws>]+ };
The <ws> token is provided by Perl 6. It is similar to \s* but it does not match the inside of a word. For example, the string “hello” does not match <ws> but the string “2+2″ does. Using tokens that refer to other tokens (including recursive definitions) you can build very complex grammars with Perl 6. In fact, the reference grammar of Perl 6 itself is written in Perl 6.
Procedures and control flow
At some point we’ll need a function to compute the result of two values and an operator. In Perl 6 you write procedure parameters explicitly, as you do in other languages:
sub do_op($lhs, $rhs, $op) {
given $op {
when '*' { $lhs * $rhs }
when '+' { $lhs + $rhs }
when '-' { $lhs - $rhs }
when '/' { $lhs / $rhs }
}
}
And here you can see Perl 6′s brand new switch statement. The keywords given and when may be less familiar than switch and case, but they are more natural and read better.
This would be a good time to see the new syntax for for loops:
for @array -> $elem {
say $elem;
}
Here you can also see the say keyword which is very much like print except that it automatically adds the \n character at the end of the string.
Main program
Now we are ready for the main program logic. Start with an skeleton:
# Read from the command line. my $str = @*ARGS[0]; if $str ~~ /^ <Expr> $/ { # Do something. } else { say "This is not an RPN expression."; }
A few things merit mention:
- The array @*ARGS contains the command arguments.
- In Perl 6, when you get a value of an array, you keep the @ symbol. So the first command argument is @*ARGS[0].
- The round brackets in an if-statement are now optional.
After a successful match, the match result is put in the $/ variable. This variable is similar to Perl 5′s $1, $2, … but more powerful. In particular, you can refer to token matches by name:
if $str ~~ /^ <Expr> $/ {
$/<Expr>; # <-- The Expr matched.
$/<Expr><Item>; # <-- A list of Item tokens.
$/<Expr><Item>[0]; # <-- The first Item token.
}
We saw earlier how to step through an array using a for loop. We can use $/<Expr><Item> the same way:
if $str ~~ /^ <Expr> $/ {
for $/<Expr><Item> -> $item {
# Do something with $item.
}
}
Now we know enough Perl 6 syntax to finish the program:
if $str ~~ /^ <Expr> $/ {
my @stack;
for $/<Expr><Item> -> $item {
if $item<Value> {
@stack.push($item<Value>);
} else {
my $v1 = @stack.pop;
my $v0 = @stack.pop;
@stack.push(do_op($v0,$v1,$item<Op>));
}
}
say @stack[0];
}
I trust that you can follow the algorithm. If not, see the Wikipedia page on RPN.
The full program
Now we are ready to see the entire program together.
token Op {'/' || '*' || '+' || '-'};
token Value { \d+[\.\d+]? };
token Item { <Value> || <Op> };
token Expr { [<ws> <Item> <ws>]+ };
# Read from the command line.
my $str = @*ARGS[0];
if $str ~~ /^ <Expr> $/ {
my @stack;
for $/<Expr><Item> -> $item {
if $item<Value> {
@stack.push($item<Value>);
} else {
my $v1 = @stack.pop;
my $v0 = @stack.pop;
@stack.push(do_op($v0,$v1,$item<Op>));
}
}
say @stack[0];
} else {
say "This is not an RPN expression.";
}
sub do_op($lhs, $rhs, $op) {
given $op {
when '*' { $lhs * $rhs }
when '+' { $lhs + $rhs }
when '-' { $lhs - $rhs }
when '/' { $lhs / $rhs }
}
}
Now you can save this to a file (RPN.pl) and run it with:
perl6 RPN.pl "5 4 + 3 / 5 3 - *"
Exercise
Modify the program to add error checking: Check that @stack has size at least 2 before running an operator and that it has size 1 before returning a result. Use +@array to get the size of an array.
I wrote an RPN calculator in Scheme at my blog. See http://programmingpraxis.wordpress.com/2009/02/19/rpn-calculator/.
As TIMTOWTDI, I implemented a multi-based version of the RPN.
http://daniel.ruoso.com/categoria/perl/rpn-calculator-perl6
Shoppers pay up to Cheap ED Hardy Shoes,Clothes lining. If you asylum’t experience the comfort of authentic <a href="http://www.hardysale.com/ED hardy yet then your feet have been lost out. Give t 160 for a pair of new Ed Hardy Shirts and Clothes but can have them repaired for just a part of that build. The compress began doing ED hardy repairs are actually asked to stuff in a study before you can guard the ribbon, because, according to a note on the spot, record hosting is pricey,ed hardy store
Sheepskin and ugg boots are a casual type of boot. Ugg boots are exceptionally warm and are great for cold weather (up to -30 degrees Fahrenheit)If you are looking for warmth while trudging around the house or the city, a sheepskin or ugg boot will be ideal.For girls and women, ugg boots look fantastic with tight-legged jeans tucked into them, or with short skirts paired with opaque tights or bare legs. For guys, ugg boots work great with jeans, and give a very casual, or rugged look, depending on the jeans or the shirt you wear with your ugg boots.site:timberlandsbuy.com
Do you have a pair of UGG Boots?If not,you must will buy a piar in our website.As we offer the best sevice and favourable price.what’s more,we charge the shipping fee.So,you just need to pay the fee of boots,and will receive our UGG boots in one week.It is very easy to have your own UGG Boots.Come on!site:timberlandsbuy.com
*features genuine twin-face sheepskin
*our signature UGG woven label
*feature a soft foam insole covered with genuine sheepskin
*have a molded EVA light and flexible outsole designed for refreshing comfort with
every step.site:timberlandsbuy.com
Everywhere you go now you find that the ugg boot has become the latest fashion new arrival cheap trend. now days it seems that you can not walk pass any window display of any shoe or fashion clothing store with seeing a pair of these trendy boots in them. it does not matter where ever you are in the world you will find ugg boots. these boots are both hot and trendy and certainly do not need to be worn in cold weather only. many people have found, that one pair of ugg boots is not enough. site:bootsness.com
We have been seller of UGG Boots for many years.Our customers are satisfied with our products as we offer the real UGG Australia Boots:
*100% authentic sheepskin for unrivalled comfort
*soft genuine sheepskin heel padding
*cushioning insole,flexible fabric-trimmed midsole.
*Lightweight molded EVA traction outsole
*Free shipping
*One week to your door
*If you dont like what youve received, simply return it! site:bootsness.com
You’d be singing a different tune if LGBT voters supported referenda to take away your right to obtain a civil marriage license that enables you and your ilk the right to a religious marriage. There’s a the north face difference between religious and civil marriage, the two aren’t the same and for your information, religious cults do NOT own marriage, the state does. Get that through your thick, primeval skull.