lib/DX/SearchState.pm

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