From: Matt S Trout Date: Mon, 3 Feb 2014 11:23:22 +0000 (+0000) Subject: introduce root set X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDKit.git;a=commitdiff_plain;h=d95799c4cfce222bcb8bffd07dd88a5d2d1e69ab introduce root set --- diff --git a/lib/DX/Op/MemberOf.pm b/lib/DX/Op/MemberOf.pm index 3bcca39..776ecf9 100644 --- a/lib/DX/Op/MemberOf.pm +++ b/lib/DX/Op/MemberOf.pm @@ -17,8 +17,7 @@ sub run { my ($member, $of) = @args{qw(member of)}; die "member bound" if $member->is_bound; my $set = $state->facts->{$of->bound_value}; - my $stream = $set->to_stream; - return $state->bind_stream_then($member, $stream, $self->next); + return $state->bind_root_set_then($member, $set, $self->next); } 1; diff --git a/lib/DX/State.pm b/lib/DX/State.pm index 9f4bf6b..106bbfc 100644 --- a/lib/DX/State.pm +++ b/lib/DX/State.pm @@ -74,6 +74,15 @@ sub bind_stream_then { )->mark_choice($bound); } +sub bind_root_set_then { + my ($self, $var, $set, $then) = @_; + my $bound = $var->with_root_set($set); + $self->but( + by_id => { %{$self->by_id}, $var->id => $bound }, + next_op => $then + )->mark_choice($bound); +} + sub mark_choice { my ($self, $var) = @_; $self->but(last_choice => [ $self, $var ]); diff --git a/lib/DX/Var.pm b/lib/DX/Var.pm index d17f375..2a1f83c 100644 --- a/lib/DX/Var.pm +++ b/lib/DX/Var.pm @@ -4,7 +4,15 @@ use Moo; has id => (is => 'ro', required => 1); -has bound_stream => (is => 'ro'); +has root_set => (is => 'ro', predicate => 1); + +has bound_stream => ( + is => 'lazy', predicate => 1, clearer => 1, + builder => sub { + my ($self) = @_; + $self->root_set->to_stream; + } +); has bound_value => (is => 'lazy', predicate => 1, clearer => 1, builder => sub { if (defined(my $next = $_[0]->bound_stream->next)) { @@ -18,7 +26,7 @@ has action => (is => 'ro'); sub is_bound { my ($self) = @_; - $self->has_bound_value || $self->bound_stream; + $self->has_bound_value || $self->has_bound_stream || $self->has_root_set; } sub with_stream { @@ -36,6 +44,11 @@ sub with_action { $self->new(%$self, action => $action); } +sub with_root_set { + my ($self, $set) = @_; + $self->new(%$self, root_set => $set); +} + sub copy { my ($self) = @_; ref($self)->new(%$self);