Commit | Line | Data |
a3104d41 |
1 | package DX::Step::ResolveProposition; |
9d759b64 |
2 | |
3e465d5d |
3 | use Types::Standard qw(ArrayRef); |
4016201b |
4 | use DX::Utils qw(deparse); |
9d759b64 |
5 | use DX::Class; |
6 | |
3e465d5d |
7 | with 'DX::Role::Step'; |
9d759b64 |
8 | |
3e465d5d |
9 | has actions => (is => 'ro', isa => ArrayRef[Action], required => 1); |
9d759b64 |
10 | |
3e465d5d |
11 | has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1); |
12 | |
ccf0d4fe |
13 | has resolves => (is => 'ro', isa => Proposition); |
14 | |
3e465d5d |
15 | has alternative_step => (is => 'ro', isa => Step); |
9d759b64 |
16 | |
4aeeab1e |
17 | sub but_first { |
18 | my ($self, @actions) = @_; |
19 | $self->but(actions => [ @actions, @{$self->actions} ]); |
20 | } |
21 | |
0498469a |
22 | sub but_with_dependencies_on { |
23 | my ($self, @deps) = @_; |
24 | $self->but(depends_on => [ @{$self->depends_on}, @deps ]); |
25 | } |
26 | |
9d759b64 |
27 | sub apply_to { |
110fd002 |
28 | my ($self, $ss) = @_; |
389ebbbb |
29 | trace 'step.apply.old_hyp '.$self => $ss->current_hypothesis; |
173a11ea |
30 | trace 'step.apply.actions '.$self => $self->actions; |
2ac94761 |
31 | my $new_ss = $self->_apply_to_ss($ss); |
32 | return $ss->but(next_step => DX::Step::Backtrack->new) unless $new_ss; |
389ebbbb |
33 | trace 'step.apply.new_hyp '.$self => $new_ss->current_hypothesis; |
1dcbfaf8 |
34 | my $ns = do { |
389ebbbb |
35 | if (my $prop = $new_ss->next_proposition) { |
86dbedb6 |
36 | DX::Step::ConsiderProposition->new( |
1dcbfaf8 |
37 | proposition => $prop |
38 | ) |
39 | } else { |
389ebbbb |
40 | $new_ss->on_solution_step |
1dcbfaf8 |
41 | } |
42 | }; |
96e5344d |
43 | my $alt_step = $self->alternative_step; |
f696251f |
44 | return ( |
389ebbbb |
45 | $new_ss->but( |
f696251f |
46 | next_step => $ns, |
96e5344d |
47 | ($alt_step |
389ebbbb |
48 | ? (alternatives => [ |
49 | [ $ss->current_hypothesis, $alt_step ], |
50 | @{$ss->alternatives} |
51 | ]) |
96e5344d |
52 | : () |
53 | ), |
f696251f |
54 | ), |
f696251f |
55 | ); |
9d759b64 |
56 | } |
57 | |
2ac94761 |
58 | sub _apply_to_ss { |
59 | my ($self, $old_ss) = @_; |
60 | my $old_hyp = $old_ss->current_hypothesis; |
77065529 |
61 | (my $hyp, my @recheck) = $old_hyp->with_resolution( |
cdca8723 |
62 | $self->resolves, $self->depends_on, $self->actions |
63 | ); |
2ac94761 |
64 | return undef unless $hyp; |
65 | return $self->_recheck_for( |
66 | $old_ss->but(current_hypothesis => $hyp), |
67 | @recheck |
68 | ); |
04844099 |
69 | } |
70 | |
2ac94761 |
71 | sub _recheck_for { |
72 | my ($self, $old_ss, @recheck) = @_; |
73 | return $old_ss unless @recheck; |
74 | my $ss = $old_ss; |
49e9aea0 |
75 | foreach my $prop (@recheck) { |
2ac94761 |
76 | return undef unless $ss = $self->_recheck_one($ss, $prop); |
49e9aea0 |
77 | } |
2ac94761 |
78 | return $ss; |
49e9aea0 |
79 | } |
80 | |
81 | sub _recheck_one { |
2ac94761 |
82 | my ($self, $old_ss, $prop) = @_; |
83 | |
84 | my $old_hyp = $old_ss->current_hypothesis; |
04844099 |
85 | |
86 | my $ap = DX::ActionPolicy::LockScope->new( |
87 | lock_to_depth => $old_hyp->scope->depth, |
88 | next_policy => $old_hyp->action_policy, |
89 | ); |
90 | |
91 | # we should probably be doing something about pruning the scope |
92 | # but that's completely pointless until we have rules |
93 | |
94 | my $hyp = ref($old_hyp)->new( |
95 | scope => $old_hyp->scope, |
96 | resolved_propositions => DX::ResolvedPropositionSet->new_empty, |
97 | actions => [], |
98 | action_applications => [], |
99 | action_policy => $ap, |
100 | ); |
101 | |
102 | my $pseq = DX::PropositionSequence->new( |
49e9aea0 |
103 | members => [ $prop ], |
04844099 |
104 | external_names => {}, |
105 | internal_names => {}, |
106 | ); |
107 | |
108 | trace 'step.recheck.hyp' => $hyp; |
109 | |
310662b5 |
110 | my $ss = DX::SearchState->new( |
111 | current_hypothesis => $hyp, |
112 | alternatives => [], |
113 | propositions => $pseq, |
114 | next_step => DX::Step::ConsiderProposition->new( |
115 | proposition => $prop, |
116 | ), |
117 | is_solution_state => 0, |
118 | on_exhaustion_step => undef, |
119 | on_solution_step => DX::Step::MarkAsSolution->new, |
120 | ); |
121 | |
122 | my $sp = DX::SearchProcess->new( |
123 | current_search_state => $ss, |
124 | ); |
04844099 |
125 | |
310662b5 |
126 | my $sol_sp = $sp->find_solution; |
04844099 |
127 | |
310662b5 |
128 | unless ($sol_sp) { |
04844099 |
129 | trace 'step.recheck.fail' => 'argh'; |
130 | return undef; |
77065529 |
131 | } |
04844099 |
132 | |
310662b5 |
133 | my $sol_rps = $sol_sp->current_hypothesis->resolved_propositions; |
04844099 |
134 | |
135 | my $rps = $old_hyp->resolved_propositions; |
136 | |
137 | $rps = $rps->with_updated_dependencies_for( |
49e9aea0 |
138 | $prop, $sol_rps->dependencies_for($prop) |
139 | ); |
04844099 |
140 | |
141 | trace 'step.recheck.done' => 'yay'; |
142 | |
2ac94761 |
143 | return $old_ss->but( |
144 | current_hypothesis => $old_hyp->but(resolved_propositions => $rps), |
145 | ); |
9d759b64 |
146 | } |
147 | |
148 | 1; |