lib/DX/QueryState.pm

   1 package DX::QueryState;
   2
   3 use Types::Standard qw(HashRef);
   4 use DX::Scope;
   5 use DX::Hypothesis;
   6 use DX::SearchProcess;
   7 use DX::ResolvedPropositionSet;
   8 use DX::Value::Unset;
   9 use DX::ActionBuilder::UnsetValue;
  10 use DX::ActionPolicy::Allow;
  11 use DX::Utils qw(:builders);
  12 use DX::Class;
  13
  14 has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
  15
  16 has globals => (is => 'ro', isa => DictValue, required => 1);
  17
  18 has proposition_sequence => (
  19   is => 'ro', isa => PropositionSequence, required => 1
  20 );
  21
  22 has search_state => (
  23   is => 'lazy', builder => sub {
  24     $_[0]->new_search_state_for($_[0]->proposition_sequence)
  25   },
  26 );
  27
  28 sub new_search_state_for {
  29   my ($self, $prop_seq) = @_;
  30   my @local_names = map { keys %{$_->introduced_names} }
  31                       @{$prop_seq->members};
  32   my $scope = DX::Scope->new(
  33     predicates => $self->predicates,
  34     globals => $self->globals,
  35     locals => [
  36       dict(
  37         map +($_ => DX::Value::Unset->new(
  38                       action_builder => DX::ActionBuilder::UnsetValue->new(
  39                         target_path => [ 0, $_ ],
  40                       )
  41                     )
  42         ), @local_names
  43       )
  44     ],
  45     lex_map => {
  46       map +($_ => [ 0, $_ ]), @local_names
  47     }
  48   );
  49   my $hyp = DX::Hypothesis->new(
  50     scope => $scope,
  51     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
  52     actions => [],
  53     action_applications => [],
  54     action_policy => DX::ActionPolicy::Allow->new,
  55   );
  56   return DX::SearchProcess->new_for($hyp, $prop_seq);
  57 }
  58
  59 sub with_additional_proposition {
  60   my ($self, $prop) = @_;
  61   my $prop_seq = $self->proposition_sequence
  62                       ->with_additional_proposition($prop);
  63   my $sol_ss = $self->new_search_state_for($prop_seq)
  64                     ->find_solution;
  65   die "No solution\n" unless $sol_ss;
  66   $self->but(
  67     proposition_sequence => $prop_seq,
  68     search_state => $sol_ss,
  69   );
  70 }
  71
  72 sub with_forced_backtrack {
  73   my ($self) = @_;
  74   my $next_ss = $self->search_state->find_next_solution;
  75   die "No next solution\n" unless $next_ss;
  76   $self->but(search_state => $next_ss);
  77 }
  78
  79 1;