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, |
f7fe6f5d |
32 | alternatives => [ |
33 | ($alt_step |
34 | ? [ $hyp, $alt_step ] |
35 | : ()), |
36 | @alt |
37 | ], |
a1aab147 |
38 | resume_step => undef, |
9d759b64 |
39 | ); |
40 | } |
72e5c0e0 |
41 | trace 'search.backtrack.alt' => $alt_step; |
9d759b64 |
42 | $step = $alt_step; |
43 | } |
44 | ($hyp, $step) = @{shift(@alt)||[]}; |
72e5c0e0 |
45 | trace 'search.backtrack.rewind_to' => $step; |
9d759b64 |
46 | } |
47 | return undef; |
48 | } |
49 | |
50 | sub find_solution { |
51 | my $state = $_[0]; |
52 | while ($state and @{$state->current_hypothesis->outstanding_propositions}) { |
53 | $state = $state->with_one_step; |
54 | } |
72e5c0e0 |
55 | trace 'search.solution.hyp' => $state->current_hypothesis if $state; |
9d759b64 |
56 | return $state; |
57 | } |
58 | |
59 | sub force_backtrack { |
60 | my ($self) = @_; |
f458fa2c |
61 | my ($first_alt, @rest_alt) = @{$self->alternatives}; |
62 | return undef unless $first_alt; |
72e5c0e0 |
63 | trace 'search.backtrack.forced' => $first_alt->[0]; |
9d759b64 |
64 | return ref($self)->new( |
65 | current_hypothesis => $first_alt->[0], |
66 | resume_step => $first_alt->[1], |
67 | alternatives => \@rest_alt |
68 | ); |
69 | } |
70 | |
71 | sub find_next_solution { |
72 | my ($self) = @_; |
73 | return undef unless my $bt = $self->force_backtrack; |
74 | return $bt->find_solution; |
75 | } |
76 | |
77 | 1; |