lib/DX/Step/ResolveProposition.pm

   1 package DX::Step::ResolveProposition;
   2
   3 use DX::Step::EnterRecheck;
   4 use DX::Step::Backtrack;
   5
   6 use DX::Utils qw(expand_deps);
   7
   8 use DX::Class;
   9
  10 with 'DX::Role::Step';
  11
  12 has resolution_space => (is => 'ro', isa => ResolutionSpace);
  13
  14 sub resolves { shift->resolution_space->proposition }
  15
  16 sub current_resolution { shift->resolution_space->next_resolution }
  17
  18 sub actions { shift->current_resolution->actions }
  19
  20 sub depends_on { shift->current_resolution->veracity_depends_on }
  21
  22 sub but_first {
  23   my ($self, @actions) = @_;
  24   $self->but(actions => [ @actions, @{$self->actions} ]);
  25 }
  26
  27 sub but_with_dependencies_on {
  28   my ($self, @deps) = @_;
  29   $self->but(depends_on => [ @{$self->depends_on}, @deps ]);
  30 }
  31
  32 sub apply_to {
  33   my ($self, $old_ss) = @_;
  34   trace resolve => [ statement => [
  35     [ symbol => 'resolve' ],
  36     [ block => [
  37       [ statement => [
  38         [ symbol => 'proposition' ],
  39         @{$self->resolves->for_deparse->[1]},
  40       ] ],
  41       (@{$self->actions}
  42         ? [ statement => [
  43             [ symbol => 'actions' ],
  44             [ block => $self->actions ],
  45           ] ]
  46         : ()),
  47       [ statement => [
  48         [ symbol => 'depends_on' ],
  49         [ block => [
  50           map [ statement => [
  51             [ symbol => (split '::', ${$_->[0]})[-1] ],
  52             [ value_path => [ @{$_}[1..$#$_] ] ]
  53           ] ], @{$self->depends_on}
  54         ] ],
  55       ] ],
  56     ] ]
  57   ] ];
  58   my $ns = do {
  59     if (my $prop = $old_ss->next_proposition) {
  60       DX::Step::ConsiderProposition->new(
  61         proposition => $prop
  62       )
  63     } else {
  64       $old_ss->on_solution_step
  65     }
  66   };
  67   my $ss = $old_ss->but(
  68     next_step => $ns,
  69     decisions_taken => [
  70       [ $self->resolution_space, $old_ss ],
  71       @{$old_ss->decisions_taken}
  72     ],
  73   );
  74   my $old_hyp = $old_ss->current_hypothesis;
  75   (my $hyp, my @recheck) = $old_hyp->with_resolution(
  76     $self->resolves, $self->depends_on, $self->actions
  77   );
  78   return $ss->but(next_step => DX::Step::Backtrack->new) unless $hyp;
  79   return $ss->but(current_hypothesis => $hyp) unless @recheck;
  80   return $ss->but(
  81     current_hypothesis => $hyp,
  82     next_step => DX::Step::EnterRecheck->new(
  83       proposition_list => \@recheck,
  84       on_completion_step => $ss->next_step,
  85       on_failure_step => DX::Step::Backtrack->new,
  86     ),
  87   );
  88 }
  89
  90 1;