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, isa => ArrayRef[Str]);
   8
   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 );
  18
  19 has expander => (
  20   is => 'ro', required => 1, isa => Expander, handles => [ qw(expand_args) ]
  21 );
  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;