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