Commit | Line | Data |
b40e416a |
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 | |
37e9670d |
9 | has rule_set => ( |
10 | is => 'lazy', |
11 | handles => [ qw(add_predicate add_rule) ], |
12 | builder => sub { |
13 | DX::RuleSet->new |
14 | }, |
15 | ); |
b40e416a |
16 | |
0676b282 |
17 | has facts => (is => 'ro', default => sub { {} }); |
b40e416a |
18 | |
e28f7460 |
19 | has observation_policy => (is => 'rw'); |
20 | |
21 | has action_callback => (is => 'rw'); |
5ef4d923 |
22 | |
b40e416a |
23 | sub query { |
7d384eca |
24 | my ($self, @terms) = @_; |
7ca660cb |
25 | $self->_solve({ allow_actions => 0 }, @terms); |
26 | } |
27 | |
28 | sub solve { |
29 | my ($self, @terms) = @_; |
30 | $self->_solve({ allow_actions => 1 }, @terms); |
31 | } |
32 | |
33 | sub ensure { |
34 | my ($self, @terms) = @_; |
35 | my $rs = $self->_solve({ allow_actions => 1 }, @terms); |
36 | my $r = $rs->next; |
37 | while ($r and $r->actions and my @ind = $r->independent_actions) { |
38 | $self->run_action($_) for @ind; |
39 | $rs = $self->_solve({ allow_actions => 1 }, @terms); |
40 | $r = $rs->next; |
41 | } |
42 | return $r; |
43 | } |
44 | |
45 | sub _solve { |
46 | my ($self, $attrs, @terms) = @_; |
b40e416a |
47 | my $rule_set = $self->rule_set; |
7d384eca |
48 | my $head = $rule_set->expand_and_link(undef, @terms, [ 'materialize' ]); |
b40e416a |
49 | my $state = DX::State->new( |
50 | next_op => $head, |
51 | return_stack => [], |
52 | by_id => {}, |
53 | scope => {}, |
54 | last_choice => [], |
55 | facts => $self->facts, |
56 | rule_set => $rule_set, |
7ca660cb |
57 | %$attrs |
7d384eca |
58 | ); |
b40e416a |
59 | return DX::ResultStream->new( |
5ef4d923 |
60 | for_state => $state, |
61 | ($self->observation_policy |
62 | ? (observation_policy => $self->observation_policy) |
63 | : ()), |
b40e416a |
64 | ); |
65 | } |
66 | |
e7117efc |
67 | sub run_action { |
68 | my ($self, $action) = @_; |
e28f7460 |
69 | if (my $cb = $self->action_callback) { |
70 | $cb->($action); |
71 | } |
e7117efc |
72 | my @invalidate = $action->run; |
73 | while (my ($type, $value) = splice @invalidate, 0, 2) { |
74 | $self->facts->{$type}->remove_value($value); |
75 | } |
76 | } |
77 | |
b40e416a |
78 | 1; |