1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
#!/usr/bin/env perl
# An "almost-RPN-ish" calculator ...
use feature 'say';
use Lowu;
if (@ARGV) {
say calc(join ' ', @ARGV)->join(" ");
exit 0
}
[
qq[Hi! I'm a RPN-ish calculator.],
qq[ - The stack only persists for a single expression.],
qq[ - Operations reduce the stack recursively.],
qq[ - Commands (anywhere in an expression):],
qq[ 'q' quits],
qq[ 'p' prints the current stack],
qq[ 'pFORMAT applies FORMAT to each stack element via (s)printf],
]->map(sub { say $_ });
STDOUT->autoflush(1);
while (1) {
print "Enter an expression:\n", "> ";
my $expr = <STDIN>;
say "result: " . calc($expr)->join(" ")
}
sub calc {
my $stack = [];
for my $item (split ' ', shift) {
if ($item eq 'q' || $item eq 'quit') {
exit 0
}
if ($item eq 'p' || $item eq 'print') {
say "stack: " . $stack->join(" ");
next
}
if (my ($format) = $item =~ /\Ap(?:rint)?(\S+)\Z/) {
$stack->map(sub { say sprintf $format, $_ });
next
}
if ($item =~ /\A[0-9]+\Z/) {
$stack->push($item);
next
}
next unless $stack->has_any;
unless ($stack->count > 1) {
warn "Not enough stack elements to perform operations\n";
next
}
if ($item eq '+') {
$stack = array( $stack->reduce(sub { shift() + shift() }) );
next
}
if ($item eq '-') {
$stack = array( $stack->reduce(sub { shift() - shift() }) );
next
}
if ($item eq '*') {
$stack = array( $stack->reduce(sub { shift() * shift() }) );
next
}
if ($item eq '/') {
$stack = array( $stack->reduce(sub { shift() / shift() }) );
next
}
if ($item eq '^' || $item eq '**') {
$stack = array( $stack->reduce(sub { shift() ** shift() }) );
next
}
warn "Unknown token: $item\n"
}
$stack
}
|
