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 => [
  35       dict(
  36         map +($_ => DX::Value::Unset->new(
  37                       action_builder => DX::ActionBuilder::UnsetValue->new(
  38                         target_path => [ 0, $_ ],
  39                       )
  40                     )
  41         ), @local_names
  42       )
  43     ],
  44     lex_map => {
  45       map +($_ => [ 0, $_ ]), @local_names
  46     }
  47   );
  48   my $hyp = DX::Hypothesis->new(
  49     scope => $scope,
  50     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
  51     actions => [],
  52     action_applications => [],
  53     action_policy => DX::ActionPolicy::Allow->new,
  54   );
  55   return DX::SearchProcess->new_for($hyp, $prop_seq);
  56 }
  57
  58 sub with_additional_proposition {
  59   my ($self, $prop) = @_;
  60   my $prop_seq = $self->proposition_sequence
  61                       ->with_additional_proposition($prop);
  62   my $sol_ss = $self->new_search_process_for($prop_seq)
  63                     ->find_solution;
  64   die "No solution\n" unless $sol_ss;
  65   $self->but(
  66     proposition_sequence => $prop_seq,
  67     search_process => $sol_ss,
  68   );
  69 }
  70
  71 sub with_forced_backtrack {
  72   my ($self) = @_;
  73   my $next_ss = $self->search_process->find_next_solution;
  74   die "No next solution\n" unless $next_ss;
  75   $self->but(search_process => $next_ss);
  76 }
  77
  78 1;