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