create explicit on_exhaustion_step attribute
[scpubgit/DX.git] / lib / DX / SearchState.pm
1 package DX::SearchState;
2
3 use Types::Standard qw(Maybe);
4 use DX::Step::Backtrack;
5 use DX::Step::InvokeNextPredicate;
6 use DX::Class;
7
8 has current_hypothesis => (is => 'ro', isa => Hypothesis, required => 1);
9
10 has next_step => (is => 'ro', isa => Maybe[Step]);
11
12 has propositions => (is => 'ro', isa => PropositionSequence, required => 1);
13
14 has alternatives => (is => 'ro', isa => AlternativeList, required => 1);
15
16 has is_solution_state => (is => 'ro', required => 1);
17
18 has on_exhaustion_step => (is => 'ro', required => 1);
19
20 sub next_proposition {
21   my ($self, $hyp) = @_;
22   $hyp ||= $self->current_hypothesis;
23   $self->propositions->members->[
24     $hyp->resolved_propositions->resolved_count
25   ];
26 }
27
28 sub new_for {
29   my ($class, $hyp, $props) = @_;
30   $class->new(
31     current_hypothesis => $hyp,
32     alternatives => [],
33     propositions => $props,
34     (@{$props->members}
35       ? (
36           next_step => DX::Step::InvokeNextPredicate->new(
37             proposition => $props->members->[0],
38           ),
39           is_solution_state => 0,
40         )
41       : ( is_solution_state => 1 )
42     ),
43     on_exhaustion_step => undef,
44   );
45 }
46
47 sub with_one_step {
48   my ($self) = @_;
49   return undef unless my $step = $self->next_step;
50   return $step->apply_to($self);
51 }
52
53 sub force_backtrack {
54   my ($self) = @_;
55   my ($first_alt, @rest_alt) = @{$self->alternatives};
56   return undef unless $first_alt;
57   trace 'search.backtrack.forced' => $first_alt->[0];
58   return $self->but(
59     next_step => DX::Step::Backtrack->new,
60   )->with_one_step;
61 }
62
63 1;