finish adding type constraints

[scpubgit/DX.git] / lib / DX / QueryState.pm

package DX::QueryState;

use DX::Scope;
use DX::Hypothesis;
use DX::SearchProcess;
use DX::ResolvedPropositionSet;
use DX::Value::Unset;
use DX::ActionBuilder::UnsetValue;
use DX::ActionPolicy::Allow;
use DX::Utils qw(:builders);
use DX::Class;

has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);

has globals => (is => 'ro', isa => DictValue, required => 1);

has proposition_sequence => (
  is => 'ro', isa => PropositionSequence, required => 1
);

has search_process => (
  is => 'lazy', isa => SearchProcess, builder => sub {
    $_[0]->new_search_process_for($_[0]->proposition_sequence)
  }, handles => { search_state => 'current_search_state' },
);

sub new_search_process_for {
  my ($self, $prop_seq) = @_;
  my @local_names = map { keys %{$_->introduced_names} }
                      @{$prop_seq->members};
  my $scope = DX::Scope->new(
    predicates => $self->predicates,
    globals => $self->globals,
    locals => [
      dict(
        map +($_ => DX::Value::Unset->new(
                      action_builder => DX::ActionBuilder::UnsetValue->new(
                        target_path => [ 0, $_ ],
                      )
                    )
        ), @local_names
      )
    ],
    lex_map => {
      map +($_ => [ 0, $_ ]), @local_names
    }
  );
  my $hyp = DX::Hypothesis->new(
    scope => $scope,
    resolved_propositions => DX::ResolvedPropositionSet->new_empty,
    actions => [],
    action_applications => [],
    action_policy => DX::ActionPolicy::Allow->new,
  );
  return DX::SearchProcess->new_for($hyp, $prop_seq);
}

sub with_additional_proposition {
  my ($self, $prop) = @_;
  my $prop_seq = $self->proposition_sequence
                      ->with_additional_proposition($prop);
  my $sol_ss = $self->new_search_process_for($prop_seq)
                    ->find_solution;
  die "No solution\n" unless $sol_ss;
  $self->but(
    proposition_sequence => $prop_seq,
    search_process => $sol_ss,
  );
}

sub with_forced_backtrack {
  my ($self) = @_;
  my $next_ss = $self->search_process->find_next_solution;
  die "No next solution\n" unless $next_ss;
  $self->but(search_process => $next_ss);
}

1;