X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDX%2FStep%2FResolveProposition.pm;h=a064b5f29c5c780fd4113e0a84a2470e81fb6e2a;hb=2548ce615db02d9ebd44d15359c1220aaf06798f;hp=d738ac18137431421339505e5a66a6e712a08a47;hpb=a3ff9ce39be445b043924592eae745c2ee84febf;p=scpubgit%2FDX.git diff --git a/lib/DX/Step/ResolveProposition.pm b/lib/DX/Step/ResolveProposition.pm index d738ac1..a064b5f 100644 --- a/lib/DX/Step/ResolveProposition.pm +++ b/lib/DX/Step/ResolveProposition.pm @@ -3,33 +3,40 @@ package DX::Step::ResolveProposition; use DX::Step::EnterRecheck; use DX::Step::Backtrack; -use Types::Standard qw(ArrayRef); -use DX::Utils qw(deparse); +use DX::Utils qw(expand_deps); use DX::Class; with 'DX::Role::Step'; -has actions => (is => 'ro', isa => ArrayRef[Action], required => 1); - -#has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1); - -has depends_on => (is => 'ro', required => 1, coerce => sub { - my ($deps) = @_; - my @exp; - DEP: foreach my $dep (@$deps) { - my ($type, @path) = @$dep; - push @exp, [ - $type, - map { ref() ? @{$_->value_path or next DEP} : $_ } @path - ]; - } - \@exp +has resolves => (is => 'lazy', init_arg => undef, builder => sub { + my ($self) = @_; + $self->resolution_space->proposition; }); -has resolves => (is => 'ro', isa => Proposition); +has resolution_space => (is => 'ro', isa => ResolutionSpace); -has alternative_step => (is => 'ro', isa => Step); +has current_resolution => (is => 'lazy', init_arg => undef, builder => sub { + my ($self) = @_; + $self->resolution_space->next_resolution; +}); + +has actions => (is => 'lazy', init_arg => undef, builder => sub { + my ($self) = @_; + $self->current_resolution->actions; +}); + +has depends_on => (is => 'lazy', init_arg => undef, builder => sub { + my ($self) = @_; + expand_deps($self->current_resolution->veracity_depends_on); +}); + +has alternative_step => (is => 'lazy', init_arg => undef, builder => sub { + my ($self) = @_; + my $rspace = $self->resolution_space->remaining_resolution_space; + return undef unless @{$rspace->members}; + return $rspace->next_step; +}); sub but_first { my ($self, @actions) = @_; @@ -43,6 +50,30 @@ sub but_with_dependencies_on { sub apply_to { my ($self, $old_ss) = @_; + trace resolve => [ statement => [ + [ symbol => 'resolve' ], + [ block => [ + [ statement => [ + [ symbol => 'proposition' ], + @{$self->resolves->for_deparse->[1]}, + ] ], + (@{$self->actions} + ? [ statement => [ + [ symbol => 'actions' ], + [ block => $self->actions ], + ] ] + : ()), + [ statement => [ + [ symbol => 'depends_on' ], + [ block => [ + map [ statement => [ + [ symbol => (split '::', ${$_->[0]})[-1] ], + [ value_path => [ @{$_}[1..$#$_] ] ] + ] ], @{$self->depends_on} + ] ], + ] ], + ] ] + ] ]; my $ns = do { if (my $prop = $old_ss->next_proposition) { DX::Step::ConsiderProposition->new( @@ -52,16 +83,12 @@ sub apply_to { $old_ss->on_solution_step } }; - my $alt_step = $self->alternative_step; my $ss = $old_ss->but( next_step => $ns, - ($alt_step - ? (adjustments_made => [ - [ $self, $old_ss ], - @{$old_ss->adjustments_made} - ]) - : () - ), + decisions_taken => [ + [ $self->resolution_space, $old_ss ], + @{$old_ss->decisions_taken} + ], ); my $new_ss = $self->_apply_to_ss($ss); return $ss->but(next_step => DX::Step::Backtrack->new) unless $new_ss;