Commit | Line | Data |
a3104d41 |
1 | package DX::Step::ResolveProposition; |
9d759b64 |
2 | |
614f3d93 |
3 | use DX::Step::EnterRecheck; |
7af7ed1e |
4 | use DX::Step::Backtrack; |
614f3d93 |
5 | |
c99dbb05 |
6 | use DX::Utils qw(expand_deps); |
614f3d93 |
7 | |
9d759b64 |
8 | use DX::Class; |
9 | |
3e465d5d |
10 | with 'DX::Role::Step'; |
9d759b64 |
11 | |
29daa554 |
12 | has resolves => (is => 'lazy', init_arg => undef, builder => sub { |
13 | my ($self) = @_; |
14 | $self->resolution_space->proposition; |
15 | }); |
9d759b64 |
16 | |
839c0018 |
17 | has resolution_space => (is => 'ro', isa => ResolutionSpace); |
3e465d5d |
18 | |
839c0018 |
19 | has current_resolution => (is => 'lazy', init_arg => undef, builder => sub { |
20 | my ($self) = @_; |
21 | $self->resolution_space->next_resolution; |
22 | }); |
23 | |
24 | has actions => (is => 'lazy', init_arg => undef, builder => sub { |
25 | my ($self) = @_; |
26 | $self->current_resolution->actions; |
27 | }); |
28 | |
29 | has depends_on => (is => 'lazy', init_arg => undef, builder => sub { |
30 | my ($self) = @_; |
c99dbb05 |
31 | expand_deps($self->current_resolution->veracity_depends_on); |
839c0018 |
32 | }); |
ccf0d4fe |
33 | |
839c0018 |
34 | has alternative_step => (is => 'lazy', init_arg => undef, builder => sub { |
35 | my ($self) = @_; |
36 | my $rspace = $self->resolution_space->remaining_resolution_space; |
37 | return undef unless @{$rspace->members}; |
29daa554 |
38 | return $rspace->next_step; |
839c0018 |
39 | }); |
9d759b64 |
40 | |
4aeeab1e |
41 | sub but_first { |
42 | my ($self, @actions) = @_; |
43 | $self->but(actions => [ @actions, @{$self->actions} ]); |
44 | } |
45 | |
0498469a |
46 | sub but_with_dependencies_on { |
47 | my ($self, @deps) = @_; |
48 | $self->but(depends_on => [ @{$self->depends_on}, @deps ]); |
49 | } |
50 | |
9d759b64 |
51 | sub apply_to { |
7af7ed1e |
52 | my ($self, $old_ss) = @_; |
5b6cab1b |
53 | trace resolve => [ statement => [ |
54 | [ symbol => 'resolve' ], |
55 | [ block => [ |
56 | [ statement => [ |
57 | [ symbol => 'proposition' ], |
58 | @{$self->resolves->for_deparse->[1]}, |
59 | ] ], |
60 | (@{$self->actions} |
61 | ? [ statement => [ |
62 | [ symbol => 'actions' ], |
c99dbb05 |
63 | [ block => $self->actions ], |
5b6cab1b |
64 | ] ] |
65 | : ()), |
93de8fb0 |
66 | [ statement => [ |
67 | [ symbol => 'depends_on' ], |
6162b001 |
68 | [ block => [ |
69 | map [ statement => [ |
70 | [ symbol => (split '::', ${$_->[0]})[-1] ], |
93de8fb0 |
71 | [ value_path => [ @{$_}[1..$#$_] ] ] |
6162b001 |
72 | ] ], @{$self->depends_on} |
93de8fb0 |
73 | ] ], |
74 | ] ], |
5b6cab1b |
75 | ] ] |
76 | ] ]; |
1dcbfaf8 |
77 | my $ns = do { |
7af7ed1e |
78 | if (my $prop = $old_ss->next_proposition) { |
86dbedb6 |
79 | DX::Step::ConsiderProposition->new( |
1dcbfaf8 |
80 | proposition => $prop |
81 | ) |
82 | } else { |
7af7ed1e |
83 | $old_ss->on_solution_step |
1dcbfaf8 |
84 | } |
85 | }; |
7af7ed1e |
86 | my $ss = $old_ss->but( |
87 | next_step => $ns, |
1c02730b |
88 | decisions_taken => [ |
89 | [ $self->resolution_space, $old_ss ], |
90 | @{$old_ss->decisions_taken} |
91 | ], |
f696251f |
92 | ); |
7af7ed1e |
93 | my $new_ss = $self->_apply_to_ss($ss); |
94 | return $ss->but(next_step => DX::Step::Backtrack->new) unless $new_ss; |
95 | return $new_ss; |
9d759b64 |
96 | } |
97 | |
2ac94761 |
98 | sub _apply_to_ss { |
99 | my ($self, $old_ss) = @_; |
100 | my $old_hyp = $old_ss->current_hypothesis; |
77065529 |
101 | (my $hyp, my @recheck) = $old_hyp->with_resolution( |
cdca8723 |
102 | $self->resolves, $self->depends_on, $self->actions |
103 | ); |
2ac94761 |
104 | return undef unless $hyp; |
105 | return $self->_recheck_for( |
106 | $old_ss->but(current_hypothesis => $hyp), |
107 | @recheck |
108 | ); |
04844099 |
109 | } |
110 | |
2ac94761 |
111 | sub _recheck_for { |
112 | my ($self, $old_ss, @recheck) = @_; |
49e9aea0 |
113 | |
31753090 |
114 | return $old_ss unless @recheck; |
2ac94761 |
115 | |
614f3d93 |
116 | my $ss = $old_ss->but( |
117 | next_step => DX::Step::EnterRecheck->new( |
31753090 |
118 | proposition_list => \@recheck, |
7af7ed1e |
119 | on_completion_step => $old_ss->next_step, |
120 | on_failure_step => DX::Step::Backtrack->new, |
614f3d93 |
121 | ), |
310662b5 |
122 | ); |
123 | |
7af7ed1e |
124 | return $ss; |
9d759b64 |
125 | } |
126 | |
127 | 1; |