[Bps-public-commit] r12614 - in pie/trunk: . lib lib/PIE/Lambda t
jesse at bestpractical.com
jesse at bestpractical.com
Thu May 22 04:02:39 EDT 2008
Author: jesse
Date: Thu May 22 04:02:38 2008
New Revision: 12614
Added:
pie/trunk/Makefile.PL
pie/trunk/TODO
Modified:
pie/trunk/ (props changed)
pie/trunk/lib/PIE.pm
pie/trunk/lib/PIE/Evaluator.pm
pie/trunk/lib/PIE/Expression.pm
pie/trunk/lib/PIE/Lambda.pm
pie/trunk/lib/PIE/Lambda/Native.pm
pie/trunk/t/01basic.t
pie/trunk/t/hello_world.t
Log:
r31868 at 31b: jesse | 2008-05-22 15:02:02 +0800
* Finish CL's deprecations from last night. Started to do parameter typechecking in the evaluator
Added: pie/trunk/Makefile.PL
==============================================================================
--- (empty file)
+++ pie/trunk/Makefile.PL Thu May 22 04:02:38 2008
@@ -0,0 +1,9 @@
+use inc::Module::Install;
+name('PIE');
+license('Perl 5.8');
+version('0E0');
+requires( perl => 5.008);
+all_from('lib/PIE.pm');
+WriteAll();
+
+
Added: pie/trunk/TODO
==============================================================================
--- (empty file)
+++ pie/trunk/TODO Thu May 22 04:02:38 2008
@@ -0,0 +1,68 @@
+Backend
+
+# is there a reason we shouldn't force _all_ arguments to _all_ functions to be named?
+
+- define named functions with typed arguments
+ - builtins
+ - control op: named subexpression?
+ -
+
+
+{ op => 'String',
+ args => { value => 'moose' } }
+
+{ op => 'Symbol',
+ args => { value => 'defined-symbol' } }
+
+{ op => 'orz',
+ args => { named1 => EXP2,
+ orz2 => EXP3 } }
+
+
+{ op => 'Increment',
+ args => { operand => { 'op' => 'symbol', args => { value => 'hate' } },
+
+{ op => 'Add',
+ args => { left => EXP,
+ right => EXP },
+}
+
+
+Lambda:
+
+bindings => Hashref of name => { type => 'foo', description => 'blah' };
+
+coerce 'PIE::FunctionArgument'
+ => form 'HashRef' via => { PIE::FunctionArgument->new( %$_ };
+
+my $l = PIE::Lambda->new( arguments => [
+ PIE::FunctionArgument->new( name => 'username', type => 'String'),
+ PIE::FunctionArgument->new( name => 'ticket', type => '??')
+
+
+ ],
+ expression => [
+ # give the ticket to the user or return fail if the user has no permission to own
+
+ ]
+
+1. lookup op, if it's PIE::Expression::$opname, use it
+2. otherwise it's a userfunc
+
+
+GUI Builder
+
+- load a serialized tree of expressions into objects
+- define a set of arguments a tree of expressions expects"
+- introspect an expression to get its name,description and arguments (incl types)
+- get a list of all "known" expressions and their arguments(incl types)
+- display a tree of expression objects
+- let user add an expression as an argument to an existing expression
+- let user add expression to run sequentially "after" another expression
+- serialize and save the tree of expressions
+- save a tree of expressions as a named thingy which can be referenced from other expressions.
+
+Hooks
+
+- allow a hook to define its name and what variables it can pass in to an expression, along with what return type it expects and some textual descriptions of these items.
+ (Create a PIE::Hook class?)
\ No newline at end of file
Modified: pie/trunk/lib/PIE.pm
==============================================================================
--- pie/trunk/lib/PIE.pm (original)
+++ pie/trunk/lib/PIE.pm Thu May 22 04:02:38 2008
@@ -1,5 +1,21 @@
+
+=head1 NAME
+
+PIE - The Pinglin Interactive Evaluator
+
+=head1 AUTHOR
+
+Jesse and CL
+
+
+=head1 LICENSE
+
+Perl
+
+=cut
+
package PIE;
-our $VERSION = sqrt(-1);
+our $VERSION = 0;
1;
Modified: pie/trunk/lib/PIE/Evaluator.pm
==============================================================================
--- pie/trunk/lib/PIE/Evaluator.pm (original)
+++ pie/trunk/lib/PIE/Evaluator.pm Thu May 22 04:02:38 2008
@@ -3,7 +3,7 @@
use Moose;
use MooseX::AttributeHelpers;
use PIE::EvaluatorResult;
-
+use Params::Validate;
has result => (
is => 'ro',
@@ -46,18 +46,10 @@
sub apply_script {
- my ($self, $lambda, @exp) = @_;
- if (ref($lambda) eq 'CODE') {
- warn " deprecated";
- $lambda->(map {$self->run($_); $self->result->value } @exp);
- }
- elsif ($lambda->isa("PIE::Lambda")) {
+ # self, a lambda, any number of positional params. (to be replaced with a params object?)
+ my ($self, $lambda, @exp) = validate_pos(@_, { isa => 'PIE::Evaluator'}, { ISA => 'PIE::Lambda'}, (0) x (@_ - 2) ) ;
# XXX: cleanup, unmask, etc
$lambda->evaluate($self, @exp);
- }
- else {
- die 'wtf';
- }
}
Modified: pie/trunk/lib/PIE/Expression.pm
==============================================================================
--- pie/trunk/lib/PIE/Expression.pm (original)
+++ pie/trunk/lib/PIE/Expression.pm Thu May 22 04:02:38 2008
@@ -116,8 +116,6 @@
sub evaluate {
my ($self, $ev) = @_;
my $result = $ev->get_named($self->symbol);
- warn $self->symbol;
- warn $result;
return $result->isa('PIE::Expression') ? $ev->run($result) : $result; # XXX: figure out evaluation order here
}
Modified: pie/trunk/lib/PIE/Lambda.pm
==============================================================================
--- pie/trunk/lib/PIE/Lambda.pm (original)
+++ pie/trunk/lib/PIE/Lambda.pm Thu May 22 04:02:38 2008
@@ -16,10 +16,19 @@
is => 'rw',
isa => 'HashRef[PIE::Function::Argument]');
+
+sub check_bindings {
+ my $self = shift;
+ my $passed = shift;
+ my $bindings = $self->bindings;
+ Carp::croak "unmatched number of arguments. ".($#{$bindings}+1)." expected. Got ".($#{$passed}+1) unless $#{$bindings} == $#{$passed};
+
+}
+
sub bind_expressions {
my ($self, $ev, @exp) = @_;
+ $self->check_bindings(\@exp);
my $bindings = $self->bindings;
- Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#exp;
$ev->set_named( $bindings->[$_] => $exp[$_] ) for 0.. $#exp;
}
Modified: pie/trunk/lib/PIE/Lambda/Native.pm
==============================================================================
--- pie/trunk/lib/PIE/Lambda/Native.pm (original)
+++ pie/trunk/lib/PIE/Lambda/Native.pm Thu May 22 04:02:38 2008
@@ -13,13 +13,11 @@
return;
}
-sub evaluatoraluate {
+sub evaluate {
my $self = shift;
my $evaluator = shift;
- my $bindings = $self->bindings;
- Carp::croak "unmatched number of arguments" unless $#{$bindings} == $#_;
-
- $self->body->(map {$evaluator->run($_); $ev->result->value } @_);
+ $self->check_bindings(\@_);
+ $self->body->(map {$evaluator->run($_); $evaluator->result->value } @_);
}
1;
Modified: pie/trunk/t/01basic.t
==============================================================================
--- pie/trunk/t/01basic.t (original)
+++ pie/trunk/t/01basic.t Thu May 22 04:02:38 2008
@@ -3,6 +3,7 @@
use_ok('PIE::Expression');
use_ok('PIE::Evaluator');
use_ok('PIE::Lambda');
+use_ok('PIE::Lambda::Native');
use_ok('PIE::Builder');
my $trivial = PIE::Expression::True->new;
@@ -34,9 +35,22 @@
ok(!$eval4->result->value);
ok($eval4->result->success);
+
+
+
+
+my $MATCH_REGEX = PIE::Lambda::Native->new( body => sub { my ($arg, $regexp) = @_;
+ return $arg =~ m/$regexp/; },
+
+ bindings => [ 'tested-string', 'regex' ],
+
+ );
+
+
+
my $eval5 = PIE::Evaluator->new;
-$eval5->set_named( 'match-regexp' => sub { my ($arg, $regexp) = @_;
- return $arg =~ m/$regexp/; });
+$eval5->set_named( 'match-regexp' => $MATCH_REGEX);
+
my $match_p = PIE::Expression->new(elements => ['match-regexp',
@@ -52,9 +66,7 @@
my $eval6 = PIE::Evaluator->new();
-$eval6->set_named( 'match-regexp' => sub { my ($arg, $regexp) = @_;
- return $arg =~ m/$regexp/; });
-
+$eval6->set_named( 'match-regexp' => $MATCH_REGEX);
@@ -93,18 +105,21 @@
my $eval9 = PIE::Evaluator->new();
-$eval9->set_named( 'match-regexp' => sub { my ($arg, $regexp) = @_;
- return $arg =~ m/$regexp/; });
+$eval9->set_named( 'match-regexp' => $MATCH_REGEX);
my $match_script = PIE::Lambda->new(
- nodes => [
- PIE::Expression->new(elements => ['match-regexp',
- PIE::Expression::Symbol->new( symbol => 'tested-string') ,
- PIE::Expression::Symbol->new( symbol => 'regex'),
- ]) ],
+ nodes => [
+ PIE::Expression->new(
+ elements => [
+ 'match-regexp',
+ PIE::Expression::Symbol->new( symbol => 'tested-string' ),
+ PIE::Expression::Symbol->new( symbol => 'regex' ),
+ ]
+ )
+ ],
bindings => [ 'tested-string', 'regex' ],
);
@@ -122,7 +137,7 @@
args => {
'if_true' => 'hate',
'if_false' => 'love',
- 'condition' => [ 'regexp-match', 'software', 'foo' ],
+ 'condition' => [ 'match-regexp', 'software', 'foo' ],
}
}
];
@@ -130,16 +145,13 @@
my $builder = PIE::Builder->new();
#use YAML;
-my $script = $builder->build_expressions($tree);
my $eval10 = PIE::Evaluator->new();
-$eval10->set_named( 'regexp-match' => sub { my ($arg, $regexp) = @_;
- return $arg =~ m/$regexp/; });
+$eval10->set_named( 'match-regexp' => $MATCH_REGEX);
-warn Dumper($script); use Data::Dumper;
-$eval10->apply_script($script);
+$eval10->apply_script( $builder->build_expressions($tree) );
ok($eval10->result->success);
is($eval10->result->value,'love');
Modified: pie/trunk/t/hello_world.t
==============================================================================
--- pie/trunk/t/hello_world.t (original)
+++ pie/trunk/t/hello_world.t Thu May 22 04:02:38 2008
@@ -56,7 +56,7 @@
use PIE::Lambda::Native;
$hello->evaluator->set_named('make-fred',
PIE::Lambda::Native->new( body => sub { return 'fred'}));
-$hello->evaluator->set_named('make-bob', sub { my $name = shift; return 'bob'});
+$hello->evaluator->set_named('make-bob', PIE::Lambda::Native->new( body => sub { my $name = shift; return 'bob'}));
$hello->evaluator->set_named('make-whoever',
PIE::Lambda::Native->new( body => sub { return $_[0] },
More information about the Bps-public-commit
mailing list