X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDX%2FStep%2FNormal.pm;h=10c4eb94636b31e15e4f53d545e28ea03a67a9a5;hb=f696251fa8f0d2648e89a3ab46c676593a9a1798;hp=8034c8cc70676dd49f6700e228464a8fc5fc7b42;hpb=4aeeab1e335ed10e9c454f6408537ea0ea85fb2f;p=scpubgit%2FDX.git diff --git a/lib/DX/Step/Normal.pm b/lib/DX/Step/Normal.pm index 8034c8c..10c4eb9 100644 --- a/lib/DX/Step/Normal.pm +++ b/lib/DX/Step/Normal.pm @@ -10,6 +10,8 @@ has actions => (is => 'ro', isa => ArrayRef[Action], required => 1); has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1); +has resolves => (is => 'ro', isa => Proposition); + has alternative_step => (is => 'ro', isa => Step); sub but_first { @@ -22,20 +24,30 @@ sub but_with_dependencies_on { $self->but(depends_on => [ @{$self->depends_on}, @deps ]); } -sub but_with_alternative_step { - my ($self, $step) = @_; - bless { %$self, alternative_step => $step }, ref($self); -} - sub apply_to { - my ($self, $old_hyp) = @_; - return ($self->_apply_to_hyp($old_hyp), $self->alternative_step); + my ($self, $ss) = @_; + my $old_hyp = $ss->current_hypothesis; + trace 'step.apply.old_hyp '.$self => $old_hyp; + trace 'step.apply.actions '.$self => $self->actions; + my $new_hyp = $self->_apply_to_hyp($old_hyp); + return (undef, $self->alternative_step) unless $new_hyp; + trace 'step.apply.new_hyp '.$self => $new_hyp; + my $ns = DX::Step::InvokeNextPredicate->new( + proposition => $ss->next_proposition($new_hyp) + ); + return ( + $ss->but( + current_hypothesis => $new_hyp, + next_step => $ns, + ), + $self->alternative_step + ); } sub _apply_to_hyp { my ($self, $old_hyp) = @_; return undef unless my $hyp = $old_hyp->with_actions(@{$self->actions}); - return $hyp->resolve_head_dependent_on($self->depends_on); + return $hyp->with_resolution($self->resolves, $self->depends_on); } 1;