lib/DX/Solver.pm

   1 package DX::Solver;
   2
   3 use DX::RuleSet;
   4 use DX::State;
   5 use DX::ResultStream;
   6 use List::Util qw(reduce);
   7 use Moo;
   8
   9 has rule_set => (
  10   is => 'lazy',
  11   handles => [ qw(add_predicate add_rule) ],
  12   builder => sub {
  13     DX::RuleSet->new
  14   },
  15 );
  16
  17 has facts => (is => 'ro', default => sub { {} });
  18
  19 has observation_policy => (is => 'ro');
  20
  21 sub query {
  22   my ($self, @terms) = @_;
  23   $self->_solve({ allow_actions => 0 }, @terms);
  24 }
  25
  26 sub solve {
  27   my ($self, @terms) = @_;
  28   $self->_solve({ allow_actions => 1 }, @terms);
  29 }
  30
  31 sub ensure {
  32   my ($self, @terms) = @_;
  33   my $rs = $self->_solve({ allow_actions => 1 }, @terms);
  34   my $r = $rs->next;
  35   while ($r and $r->actions and my @ind = $r->independent_actions) {
  36     $self->run_action($_) for @ind;
  37     $rs = $self->_solve({ allow_actions => 1 }, @terms);
  38     $r = $rs->next;
  39   }
  40   return $r;
  41 }
  42
  43 sub _solve {
  44   my ($self, $attrs, @terms) = @_;
  45   my $rule_set = $self->rule_set;
  46   my $head = $rule_set->expand_and_link(undef, @terms, [ 'materialize' ]);
  47   my $state = DX::State->new(
  48     next_op => $head,
  49     return_stack => [],
  50     by_id => {},
  51     scope => {},
  52     last_choice => [],
  53     facts => $self->facts,
  54     rule_set => $rule_set,
  55     %$attrs
  56   );
  57   return DX::ResultStream->new(
  58     for_state => $state,
  59     ($self->observation_policy
  60       ? (observation_policy => $self->observation_policy)
  61       : ()),
  62   );
  63 }
  64
  65 sub run_action {
  66   my ($self, $action) = @_;
  67   warn +(split('::', ref($action)))[-1]."\n";
  68   my @invalidate = $action->run;
  69   while (my ($type, $value) = splice @invalidate, 0, 2) {
  70     $self->facts->{$type}->remove_value($value);
  71   }
  72 }
  73
  74 1;