our
$VERSION
=
'0.15'
;
has
'args'
=> [];
sub
command {
my
(
$self
) =
@_
;
my
$args
=
$self
->args;
my
$input
;
if
(
@$args
) {
if
(-f
$args
->[0]) {
open
my
$fh
,
$args
->[0] or
die
;
$input
=
do
{
local
$/; <
$fh
> };
}
else
{
die
"Unknown args"
;
}
}
else
{
$input
=
do
{
local
$/; <> };
}
$self
->run(
$input
);
}
sub
run {
my
(
$self
,
$input
) =
@_
;
my
$exec
= Pegex::Forth::Exec->new;
my
$parser
= Pegex::Parser->new(
grammar
=> Pegex::Forth::Grammar->new,
receiver
=>
$exec
,
);
$parser
->parse(
$input
);
my
$values
=
$exec
->runtime->stack;
return
unless
@$values
;
wantarray
?
@$values
:
$values
->[-1];
}
forth: - token*
token:
| number
| comment
| word
number: /( DASH? DIGIT+ ) +/
comment: /'(' + ALL*? ')' +/
word: /( NS+ ) +/
ws: / (: WS | EOS ) /
...
has
runtime
=>
sub
{ Pegex::Forth::Runtime->new };
sub
got_number {
my
(
$self
,
$number
) =
@_
;
$self
->runtime->
push
(
$number
);
}
sub
got_word {
my
(
$self
,
$word
) =
@_
;
$self
->runtime->call(
$word
);
}
1;