Commit | Line | Data |
9eedd677 |
1 | package DX::QueryState; |
2 | |
384a5e93 |
3 | use DX::Scope; |
4 | use DX::Hypothesis; |
8c16d3c9 |
5 | use DX::SearchProcess; |
384a5e93 |
6 | use DX::ResolvedPropositionSet; |
384a5e93 |
7 | use DX::ActionPolicy::Allow; |
ae6f4d03 |
8 | use DX::Step::MarkAsExhaustion; |
384a5e93 |
9 | use DX::Utils qw(:builders); |
9eedd677 |
10 | use DX::Class; |
11 | |
fa8f5696 |
12 | has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1); |
13 | |
14 | has globals => (is => 'ro', isa => DictValue, required => 1); |
15 | |
16 | has proposition_sequence => ( |
17 | is => 'ro', isa => PropositionSequence, required => 1 |
18 | ); |
9eedd677 |
19 | |
cfae7810 |
20 | has search_process => ( |
21 | is => 'lazy', isa => SearchProcess, builder => sub { |
22 | $_[0]->new_search_process_for($_[0]->proposition_sequence) |
23 | }, handles => { search_state => 'current_search_state' }, |
384a5e93 |
24 | ); |
25 | |
cfae7810 |
26 | sub new_search_process_for { |
384a5e93 |
27 | my ($self, $prop_seq) = @_; |
5f12a9d8 |
28 | my @local_names = map { keys %{$_->introduced_names} } |
384a5e93 |
29 | @{$prop_seq->members}; |
30 | my $scope = DX::Scope->new( |
31 | predicates => $self->predicates, |
32 | globals => $self->globals, |
2fe8c22a |
33 | locals => [ dict() ], |
34 | lex_map => { } |
384a5e93 |
35 | ); |
36 | my $hyp = DX::Hypothesis->new( |
37 | scope => $scope, |
38 | resolved_propositions => DX::ResolvedPropositionSet->new_empty, |
384a5e93 |
39 | actions => [], |
e442aff8 |
40 | action_applications => [], |
384a5e93 |
41 | action_policy => DX::ActionPolicy::Allow->new, |
42 | ); |
8c16d3c9 |
43 | return DX::SearchProcess->new_for($hyp, $prop_seq); |
384a5e93 |
44 | } |
45 | |
46 | sub with_additional_proposition { |
ed70e2d8 |
47 | my ($self, $new_prop) = @_; |
48 | my $old_prop_seq = $self->proposition_sequence; |
49 | my $new_prop_seq = $old_prop_seq->with_additional_proposition($new_prop); |
50 | my $old_ss = $self->search_process->current_search_state; |
51 | my %seen; |
52 | my $_munge; $_munge = sub { |
53 | my ($ss) = @_; |
54 | return $seen{$ss} ||= do { |
55 | my %but = ( |
56 | decisions_taken => [ |
57 | map [ $_->[0], $_->[1]->$_munge ], @{$ss->decisions_taken} |
58 | ] |
59 | ); |
60 | if ($ss->propositions eq $old_prop_seq) { |
61 | $but{propositions} = $new_prop_seq; |
62 | } |
63 | foreach my $type (qw(on_solution_step on_exhaustion_step)) { |
64 | my $step = $ss->$type; |
65 | if ($step and $step->can('resume_search_state')) { |
66 | $but{$type} |
67 | = $seen{$step} |
68 | ||= $step->but( |
69 | resume_search_state => $step->resume_search_state->$_munge |
70 | ); |
71 | } |
72 | } |
d6b0c811 |
73 | if ((my $next_step = $ss->next_step)->can('original_search_state')) { |
74 | $but{next_step} |
75 | = $seen{$next_step} |
76 | ||= $next_step->but( |
77 | original_search_state |
78 | => $next_step->original_search_state->$_munge |
79 | ); |
80 | } |
81 | |
ed70e2d8 |
82 | $ss->but(%but); |
83 | }; |
84 | }; |
85 | my $munged_ss = $old_ss->$_munge; |
86 | undef($_munge); |
87 | |
88 | my $new_ss = $munged_ss->but( |
89 | is_solution_state => 0, |
90 | next_step => DX::Step::ConsiderProposition->new( |
91 | proposition => $new_prop |
92 | ), |
93 | ); |
94 | |
95 | my $sol_sp = $self->search_process |
96 | ->but(current_search_state => $new_ss) |
31d445d3 |
97 | ->find_solution; |
ed70e2d8 |
98 | die "No solution\n" unless $sol_sp; |
384a5e93 |
99 | $self->but( |
ed70e2d8 |
100 | proposition_sequence => $new_prop_seq, |
101 | search_process => $sol_sp, |
384a5e93 |
102 | ); |
103 | } |
104 | |
f458fa2c |
105 | sub with_forced_backtrack { |
106 | my ($self) = @_; |
cfae7810 |
107 | my $next_ss = $self->search_process->find_next_solution; |
f458fa2c |
108 | die "No next solution\n" unless $next_ss; |
cfae7810 |
109 | $self->but(search_process => $next_ss); |
f458fa2c |
110 | } |
111 | |
9eedd677 |
112 | 1; |