use MooseX::Types::Structured qw(Dict Tuple);
use MooseX::Types::Moose qw(
Int
- Str
+ Str
ScalarRef
);
use MooseX::Types -declare => [qw(
Var
Const
Pair
- Op
+ Op
BinOp
- Lambda
- App
+ Lambda
+ App
Expr
)];
my ($source, $e) = @_;
$e ||= {};
#use Data::Dumper; warn "run(e) => " . Dumper $e;
- return match $source,
- Var() => sub { $e->{ ${$_} } },
- Const() => sub { $_[0] },
- BinOp() => sub { $_->[1] eq '+'
+ return match $source,
+ Var() => sub { $e->{ ${$_} } },
+ Const() => sub { $_[0] },
+ BinOp() => sub { $_->[1] eq '+'
? ( run( $_->[0], $e ) + run( $_->[2], $e ) )
- : ( run( $_->[0], $e ) - run( $_->[2], $e ) ) },
- Lambda() => sub { $_ },
- App() => sub {
+ : ( run( $_->[0], $e ) - run( $_->[2], $e ) ) },
+ Lambda() => sub { $_ },
+ App() => sub {
my ( $p, $body ) = @{ run( $_[0]->[0], $e ) };
$e->{ ${ $p } } = run( $_[0]->[1], $e );
run( $body, $e );
- },
- Pair() => sub { $_ },
+ },
+ Pair() => sub { $_ },
Expr() => sub { run($_, $e) },
sub { confess "[run] Bad Source:" . Dumper $_ };
}
sub pprint {
my ($source) = @_;
- return match $source,
- Var() => sub { 'Var(' . ${$_} . ')' },
- Op() => sub { 'Op(' . $_ . ')' },
- Const() => sub { 'Const(' . $_ . ')' },
+ return match $source,
+ Var() => sub { 'Var(' . ${$_} . ')' },
+ Op() => sub { 'Op(' . $_ . ')' },
+ Const() => sub { 'Const(' . $_ . ')' },
BinOp() => sub { 'BinOp( ' . ( join ' ' => map { pprint($_) } @{$_} ) . ' )' },
Lambda() => sub { "Lambda( " . pprint($_->[0]) . ' ' . pprint($_->[1]) . " )" },
- App() => sub { "App( " . pprint($_->[0]) . ' ' . pprint($_->[1]) . " )" },
- Pair() => sub { 'Pair(' . pprint($_->[0]) . ' => ' . pprint($_->[1]) . ')' },
+ App() => sub { "App( " . pprint($_->[0]) . ' ' . pprint($_->[1]) . " )" },
+ Pair() => sub { 'Pair(' . pprint($_->[0]) . ' => ' . pprint($_->[1]) . ')' },
Expr() => sub { pprint($_) },
sub { confess "[pprint] Bad Source:" . Dumper $_ };
}
BEGIN { Interpreter->import(':all') };
ok is_Var(\'x'), q{passes is_Var('x')};
-
+
ok is_Const(1), q{passes is_Const(1)};
ok is_Const('Hello World'), q{passes is_Const};
-
- ok is_Pair([ 'Hello', 'World' ]), q{passes is_Pair};
- ok is_Pair([ \'Hello', 'World' ]), q{passes is_Pair};
- ok is_Pair([ \'Hello', 100 ]), q{passes is_Pair};
- ok is_Pair([ \'Hello', [ 1, '+', 1] ]), q{passes is_Pair};
+
+ ok is_Pair([ 'Hello', 'World' ]), q{passes is_Pair};
+ ok is_Pair([ \'Hello', 'World' ]), q{passes is_Pair};
+ ok is_Pair([ \'Hello', 100 ]), q{passes is_Pair};
+ ok is_Pair([ \'Hello', [ 1, '+', 1] ]), q{passes is_Pair};
ok is_Op('+'), q{passes is_Op('+')};
ok is_Op('-'), q{passes is_Op('-')};
ok is_BinOp([ 1, '+', 1]), q{passes is_BinOp([ 1, '+', 1])};
ok is_BinOp([ '+', '+', '+' ]), q{passes is_BinOp([ '+', '+', '+' ])};
- ok is_BinOp([ 1, '+', [ 1, '+', 1 ]]), q{passes is_BinOp([ 1, '+', 1])};
-
- ok is_Lambda([ \'x', [ \'x', '+', \'x' ]]), q{passes is_Lambda};
- ok is_App([ [ \'x', [ \'x', '+', \'x' ]], 10 ]), q{passes is_App};
+ ok is_BinOp([ 1, '+', [ 1, '+', 1 ]]), q{passes is_BinOp([ 1, '+', 1])};
+
+ ok is_Lambda([ \'x', [ \'x', '+', \'x' ]]), q{passes is_Lambda};
+ ok is_App([ [ \'x', [ \'x', '+', \'x' ]], 10 ]), q{passes is_App};
ok Expr->check([ 11, '+', 12]), '... check is supported';
ok is_Expr(\'x'), q{passes is_Expr(\'x')};
- ok is_Expr(10), q{passes is_Expr(10)};
+ ok is_Expr(10), q{passes is_Expr(10)};
ok is_Expr([ 1, '+', 1]), q{passes is_Expr([ 1, '+', 1])};
ok is_Expr([ 1, '+', [ 1, '+', 1 ]]), q{passes is_Expr([ 1, '+', [ 1, '+', 1 ]])};
is Interpreter::pprint($source),
'App( Lambda( Var(x) BinOp( Var(x) Op(+) Var(x) ) ) Const(10) )',
'... pretty printed correctly';
-
- is Interpreter::run([ 1, '+', 1 ]), 2, '... eval-ed correctly';
-
- is Interpreter::run([ 1, '+', [ 1, '+', 1 ] ]), 3, '... eval-ed correctly';
-
+
+ is Interpreter::run([ 1, '+', 1 ]), 2, '... eval-ed correctly';
+
+ is Interpreter::run([ 1, '+', [ 1, '+', 1 ] ]), 3, '... eval-ed correctly';
+
is_deeply Interpreter::run([ \'x', [ \'x', '+', \'x' ]]),
[ \'x', [ \'x', '+', \'x' ]],
- '... eval-ed correctly';
-
- is Interpreter::run($source), 20, '... eval-ed correctly';
-
+ '... eval-ed correctly';
+
+ is Interpreter::run($source), 20, '... eval-ed correctly';
+
is Interpreter::run(
[
[ \'x', [ \'x', '+', \'x' ] ],
[ 2, '+', 2 ]
]
- ), 8, '... eval-ed correctly';
-
+ ), 8, '... eval-ed correctly';
+
}