Commit | Line | Data |
9d759b64 |
1 | package DX::SearchState; |
2 | |
a1aab147 |
3 | use Types::Standard qw(Maybe); |
e647e417 |
4 | use DX::Step::InvokeNextPredicate; |
9d759b64 |
5 | use DX::Class; |
6 | |
3e465d5d |
7 | has current_hypothesis => (is => 'ro', isa => Hypothesis, required => 1); |
9d759b64 |
8 | |
e647e417 |
9 | has next_step => (is => 'ro', isa => Maybe[Step]); |
9d759b64 |
10 | |
1350f664 |
11 | has propositions => (is => 'ro', isa => PropositionSequence, required => 1); |
12 | |
3e465d5d |
13 | has alternatives => (is => 'ro', isa => AlternativeList, required => 1); |
14 | |
ccf0d4fe |
15 | sub next_proposition { $_[0]->current_hypothesis->head_proposition } |
16 | |
3e465d5d |
17 | sub new_for { |
1350f664 |
18 | my ($class, $hyp, $props) = @_; |
3e465d5d |
19 | $class->new( |
20 | current_hypothesis => $hyp, |
21 | alternatives => [], |
ccf0d4fe |
22 | next_step => DX::Step::InvokeNextPredicate->new( |
23 | proposition => $hyp->head_proposition, |
24 | ), |
1350f664 |
25 | propositions => $props, |
3e465d5d |
26 | ); |
27 | } |
9d759b64 |
28 | |
29 | sub with_one_step { |
30 | my ($self) = @_; |
31 | my $hyp = $self->current_hypothesis; |
e647e417 |
32 | return undef unless my $step = $self->next_step; |
33 | my ($first_alt, @rest_alt) = my @alt = @{$self->alternatives}; |
34 | my ($new_hyp, $alt_step) = $step->apply_to($hyp); |
35 | if ($new_hyp) { |
36 | return $self->but( |
37 | current_hypothesis => $new_hyp, |
38 | alternatives => [ |
39 | ($alt_step |
40 | ? [ $hyp, $alt_step ] |
41 | : ()), |
42 | @alt |
43 | ], |
ccf0d4fe |
44 | next_step => DX::Step::InvokeNextPredicate->new( |
45 | proposition => $self->next_proposition, |
46 | ), |
e647e417 |
47 | ); |
9d759b64 |
48 | } |
e647e417 |
49 | if ($alt_step) { |
50 | return $self->but(next_step => $alt_step); |
51 | } |
52 | return undef unless $first_alt; |
53 | trace 'search.backtrack.rewind_to' => $first_alt->[1]; |
54 | return $self->but( |
55 | current_hypothesis => $first_alt->[0], |
56 | alternatives => \@rest_alt, |
57 | next_step => $first_alt->[1], |
58 | ); |
9d759b64 |
59 | } |
60 | |
61 | sub find_solution { |
62 | my $state = $_[0]; |
63 | while ($state and @{$state->current_hypothesis->outstanding_propositions}) { |
64 | $state = $state->with_one_step; |
65 | } |
72e5c0e0 |
66 | trace 'search.solution.hyp' => $state->current_hypothesis if $state; |
9d759b64 |
67 | return $state; |
68 | } |
69 | |
70 | sub force_backtrack { |
71 | my ($self) = @_; |
f458fa2c |
72 | my ($first_alt, @rest_alt) = @{$self->alternatives}; |
73 | return undef unless $first_alt; |
72e5c0e0 |
74 | trace 'search.backtrack.forced' => $first_alt->[0]; |
9d759b64 |
75 | return ref($self)->new( |
76 | current_hypothesis => $first_alt->[0], |
e647e417 |
77 | next_step => $first_alt->[1], |
1350f664 |
78 | alternatives => \@rest_alt, |
79 | propositions => $self->propositions, |
9d759b64 |
80 | ); |
81 | } |
82 | |
83 | sub find_next_solution { |
84 | my ($self) = @_; |
85 | return undef unless my $bt = $self->force_backtrack; |
86 | return $bt->find_solution; |
87 | } |
88 | |
89 | 1; |