lib/DX/SearchState.pm

   1 package DX::SearchState;
   2
   3 use Types::Standard qw(Maybe);
   4 use DX::Class;
   5
   6 has current_hypothesis => (is => 'ro', isa => Hypothesis, required => 1);
   7
   8 has resume_step => (is => 'ro', isa => Maybe[Step]);
   9
  10 has alternatives => (is => 'ro', isa => AlternativeList, required => 1);
  11
  12 sub new_for {
  13   my ($class, $hyp) = @_;
  14   $class->new(
  15     current_hypothesis => $hyp,
  16     alternatives => [],
  17   );
  18 }
  19
  20 sub with_one_step {
  21   my ($self) = @_;
  22   my $hyp = $self->current_hypothesis;
  23   my $step = $self->resume_step
  24              || $hyp->head_proposition->resolve_for($hyp->scope);
  25   my @alt = @{$self->alternatives};
  26   HYP: while ($hyp) {
  27     STEP: while ($step) {
  28       my ($new_hyp, $alt_step) = $step->apply_to($hyp);
  29       if ($new_hyp) {
  30         return $self->but(
  31           current_hypothesis => $new_hyp,
  32           alternatives => [
  33             ($alt_step
  34               ? [ $hyp, $alt_step ]
  35               : ()),
  36             @alt
  37           ],
  38           resume_step => undef,
  39         );
  40       }
  41       trace 'search.backtrack.alt' => $alt_step;
  42       $step = $alt_step;
  43     }
  44     ($hyp, $step) = @{shift(@alt)||[]};
  45     trace 'search.backtrack.rewind_to' => $step;
  46   }
  47   return undef;
  48 }
  49
  50 sub find_solution {
  51   my $state = $_[0];
  52   while ($state and @{$state->current_hypothesis->outstanding_propositions}) {
  53     $state = $state->with_one_step;
  54   }
  55   trace 'search.solution.hyp' => $state->current_hypothesis if $state;
  56   return $state;
  57 }
  58
  59 sub force_backtrack {
  60   my ($self) = @_;
  61   my ($first_alt, @rest_alt) = @{$self->alternatives};
  62   return undef unless $first_alt;
  63   trace 'search.backtrack.forced' => $first_alt->[0];
  64   return ref($self)->new(
  65     current_hypothesis => $first_alt->[0],
  66     resume_step => $first_alt->[1],
  67     alternatives => \@rest_alt
  68   );
  69 }
  70
  71 sub find_next_solution {
  72   my ($self) = @_;
  73   return undef unless my $bt = $self->force_backtrack;
  74   return $bt->find_solution;
  75 }
  76
  77 1;