X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDX%2FSearchState.pm;h=553b304e0eaa994fa4b14eff62d56674a0a322dc;hb=91543b6231e8bf4af4ce781efa2056b299a843e9;hp=d119d9b4983f942fb191002b64f190f14bb9d15c;hpb=110fd00291e5e8ae2f7f1bccde19307b5bba118a;p=scpubgit%2FDX.git diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm index d119d9b..553b304 100644 --- a/lib/DX/SearchState.pm +++ b/lib/DX/SearchState.pm @@ -1,17 +1,25 @@ package DX::SearchState; use Types::Standard qw(Maybe); -use DX::Step::InvokeNextPredicate; +use DX::Step::Backtrack; +use DX::Step::ConsiderProposition; +use DX::Step::MarkAsSolution; use DX::Class; has current_hypothesis => (is => 'ro', isa => Hypothesis, required => 1); -has next_step => (is => 'ro', isa => Maybe[Step]); +has next_step => (is => 'ro', isa => Maybe[Step], required => 1); has propositions => (is => 'ro', isa => PropositionSequence, required => 1); has alternatives => (is => 'ro', isa => AlternativeList, required => 1); +has is_solution_state => (is => 'ro', required => 1); + +has on_exhaustion_step => (is => 'ro', isa => Maybe[Step], required => 1); + +has on_solution_step => (is => 'ro', isa => Maybe[Step], required => 1); + sub next_proposition { my ($self, $hyp) = @_; $hyp ||= $self->current_hypothesis; @@ -25,44 +33,25 @@ sub new_for { $class->new( current_hypothesis => $hyp, alternatives => [], - next_step => DX::Step::InvokeNextPredicate->new( - proposition => $props->members->[0], - ), propositions => $props, + (@{$props->members} + ? ( + next_step => DX::Step::ConsiderProposition->new( + proposition => $props->members->[0], + ), + is_solution_state => 0, + ) + : ( next_step => undef, is_solution_state => 1 ) + ), + on_exhaustion_step => undef, + on_solution_step => DX::Step::MarkAsSolution->new, ); } sub with_one_step { my ($self) = @_; - my $hyp = $self->current_hypothesis; return undef unless my $step = $self->next_step; - my ($first_alt, @rest_alt) = my @alt = @{$self->alternatives}; - my ($new_ss, $alt_step) = $step->apply_to($self); - my $new_hyp = ($new_ss ? $new_ss->current_hypothesis : undef); - if ($new_hyp) { - return $self->but( - current_hypothesis => $new_hyp, - alternatives => [ - ($alt_step - ? [ $hyp, $alt_step ] - : ()), - @alt - ], - next_step => DX::Step::InvokeNextPredicate->new( - proposition => $self->next_proposition($new_hyp), - ), - ); - } - if ($alt_step) { - return $self->but(next_step => $alt_step); - } - return undef unless $first_alt; - trace 'search.backtrack.rewind_to' => $first_alt->[1]; - return $self->but( - current_hypothesis => $first_alt->[0], - alternatives => \@rest_alt, - next_step => $first_alt->[1], - ); + return $step->apply_to($self); } sub force_backtrack { @@ -70,12 +59,9 @@ sub force_backtrack { my ($first_alt, @rest_alt) = @{$self->alternatives}; return undef unless $first_alt; trace 'search.backtrack.forced' => $first_alt->[0]; - return ref($self)->new( - current_hypothesis => $first_alt->[0], - next_step => $first_alt->[1], - alternatives => \@rest_alt, - propositions => $self->propositions, - ); + return $self->but( + next_step => DX::Step::Backtrack->new, + )->with_one_step; } 1;