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