lib/DX/RuleDefinitionContext.pm

   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;