lib/DX/QueryState.pm

   1 package DX::QueryState;
   2
   3 use DX::Scope;
   4 use DX::Hypothesis;
   5 use DX::SearchProcess;
   6 use DX::ResolvedPropositionSet;
   7 use DX::ActionPolicy::Allow;
   8 use DX::Step::MarkAsExhaustion;
   9 use DX::Utils qw(:builders);
  10 use DX::Class;
  11
  12 has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
  13
  14 has globals => (is => 'ro', isa => DictValue, required => 1);
  15
  16 has proposition_sequence => (
  17   is => 'ro', isa => PropositionSequence, required => 1
  18 );
  19
  20 has search_process => (
  21   is => 'lazy', isa => SearchProcess, builder => sub {
  22     $_[0]->new_search_process_for($_[0]->proposition_sequence)
  23   }, handles => { search_state => 'current_search_state' },
  24 );
  25
  26 sub new_search_process_for {
  27   my ($self, $prop_seq) = @_;
  28   my @local_names = map { keys %{$_->introduced_names} }
  29                       @{$prop_seq->members};
  30   my $scope = DX::Scope->new(
  31     predicates => $self->predicates,
  32     globals => $self->globals,
  33     locals => [ dict() ],
  34     lex_map => { }
  35   );
  36   my $hyp = DX::Hypothesis->new(
  37     scope => $scope,
  38     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
  39     actions => [],
  40     action_applications => [],
  41     action_policy => DX::ActionPolicy::Allow->new,
  42   );
  43   return DX::SearchProcess->new_for($hyp, $prop_seq);
  44 }
  45
  46 sub with_additional_proposition {
  47   my ($self, $new_prop) = @_;
  48   my $old_prop_seq = $self->proposition_sequence;
  49   my $new_prop_seq = $old_prop_seq->with_additional_proposition($new_prop);
  50   my $old_ss = $self->search_process->current_search_state;
  51   my %seen;
  52   my $_munge; $_munge = sub {
  53     my ($ss) = @_;
  54     return $seen{$ss} ||= do {
  55       my %but = (
  56         decisions_taken => [
  57           map [ $_->[0], $_->[1]->$_munge ], @{$ss->decisions_taken}
  58         ]
  59       );
  60       if ($ss->propositions eq $old_prop_seq) {
  61         $but{propositions} = $new_prop_seq;
  62       }
  63       foreach my $type (qw(on_solution_step on_exhaustion_step)) {
  64         my $step = $ss->$type;
  65         if ($step and $step->can('resume_search_state')) {
  66           $but{$type}
  67             = $seen{$step}
  68             ||= $step->but(
  69                   resume_search_state => $step->resume_search_state->$_munge
  70                 );
  71         }
  72       }
  73       $ss->but(%but);
  74     };
  75   };
  76   my $munged_ss = $old_ss->$_munge;
  77   undef($_munge);
  78
  79   my $new_ss = $munged_ss->but(
  80     is_solution_state => 0,
  81     next_step => DX::Step::ConsiderProposition->new(
  82                    proposition => $new_prop
  83                  ),
  84   );
  85
  86   my $sol_sp = $self->search_process
  87                     ->but(current_search_state => $new_ss)
  88                     ->find_solution;
  89   die "No solution\n" unless $sol_sp;
  90   $self->but(
  91     proposition_sequence => $new_prop_seq,
  92     search_process => $sol_sp,
  93   );
  94 }
  95
  96 sub with_forced_backtrack {
  97   my ($self) = @_;
  98   my $next_ss = $self->search_process->find_next_solution;
  99   die "No next solution\n" unless $next_ss;
 100   $self->but(search_process => $next_ss);
 101 }
 102
 103 1;