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