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           ($alt_step
  33              ? (alternatives => [
  34                   [ $hyp, $alt_step ],
  35                   @alt
  36                ])
  37              : ()),
  38           resume_step => undef,
  39         );
  40       }
  41       $step = $alt_step;
  42     }
  43     ($hyp, $step) = @{shift(@alt)||[]};
  44   }
  45   return undef;
  46 }
  47
  48 sub find_solution {
  49   my $state = $_[0];
  50   while ($state and @{$state->current_hypothesis->outstanding_propositions}) {
  51     $state = $state->with_one_step;
  52   }
  53   return $state;
  54 }
  55
  56 sub force_backtrack {
  57   my ($self) = @_;
  58   my ($first_alt, @rest_alt) = @{$self->alternatives};
  59   return undef unless $first_alt;
  60   trace 'search.backtrack' => $first_alt->[0];
  61   return ref($self)->new(
  62     current_hypothesis => $first_alt->[0],
  63     resume_step => $first_alt->[1],
  64     alternatives => \@rest_alt
  65   );
  66 }
  67
  68 sub find_next_solution {
  69   my ($self) = @_;
  70   return undef unless my $bt = $self->force_backtrack;
  71   return $bt->find_solution;
  72 }
  73
  74 1;