Commit | Line | Data |
2bf57c95 |
1 | package DX::RuleDefinitionContext; |
2 | |
3 | use DX::PropositionSequence; |
4 | use DX::Predicate::Rule; |
5 | use DX::Class; |
6 | |
7 | has arg_names => (is => 'ro', required => 1); |
8 | |
9 | has proposition_sequence => (is => 'rwp', lazy => 1, builder => sub { |
10 | my ($self) = @_; |
11 | my %arg_names = map +($_ => 1), @{$self->arg_names}; |
12 | DX::PropositionSequence->new_empty |
13 | ->but(external_names => \%arg_names); |
14 | }); |
15 | |
16 | has expander => (is => 'ro', required => 1, handles => [ qw(expand_args) ]); |
17 | |
18 | sub apply_predicate { |
19 | my ($self, $pred, @arg_strings) = @_; |
20 | my @args = $self->expand_args(@arg_strings); |
21 | my ($intro, $need) = ({}, {}); |
22 | foreach my $arg (@args) { |
23 | next if ref($arg); |
24 | next if $arg =~ /^\??[a-z]/; # skip globals |
25 | # ?Foo is intro, Foo is need |
26 | ($arg =~ s/^\?// ? $intro : $need)->{$arg} = 1; |
27 | } |
28 | my $prop = DX::Proposition->new( |
29 | predicate => $pred, |
30 | args => \@args, |
31 | introduced_names => $intro, |
32 | required_names => $need, |
33 | ); |
34 | $self->_set_proposition_sequence( |
35 | $self->proposition_sequence->with_additional_proposition($prop) |
36 | ); |
37 | return; |
38 | } |
39 | |
40 | sub bake_rule { |
41 | my ($self) = @_; |
42 | DX::Predicate::Rule->new( |
43 | arg_names => $self->arg_names, |
44 | proposition_sequence => $self->proposition_sequence |
45 | ); |
46 | } |
47 | |
48 | 1; |