lib/DX/Scope.pm

   1 package DX::Scope;
   2
   3 use Types::Standard qw(HashRef ArrayRef);
   4 use DX::Class;
   5
   6 has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
   7
   8 has globals => (is => 'ro', isa => DictValue, required => 1);
   9
  10 has locals => (is => 'ro', isa => ArrayRef[DictValue], required => 1);
  11
  12 has lex_map => (is => 'ro', isa => HashRef, required => 1);
  13
  14 #has known_facts => (is => 'ro', required => 1);
  15
  16 sub lookup_predicate {
  17   my ($self, $predicate) = @_;
  18   return $self->predicates->{$predicate} || die "No such predicate: $predicate";
  19 }
  20
  21 sub lookup {
  22   my ($self, $symbol) = @_;
  23   if ($symbol =~ /^[_A-Z]/) {
  24     my @mapped = @{$self->lex_map->{$symbol}||[]}
  25       or die "No such name in scope: $symbol";
  26     my $targ = $self;
  27     $targ = $targ->get_member_at($_) for @mapped;
  28     return $targ;
  29   }
  30   return $self->globals->get_member_at($symbol)
  31    || die "No such name in scope: $symbol";
  32 }
  33
  34 sub depth { $#{$_[0]->locals} }
  35
  36 sub prune_to {
  37   my ($self, $to) = @_;
  38   $self->but(locals => [ @{$self->locals}[0..$to] ]);
  39 }
  40
  41 sub get_member_at {
  42   my ($self, $at) = @_;
  43   if ($at =~ /^[0-9]+$/) {
  44     return $self->locals->[$at];
  45   }
  46   return $self->globals->get_member_at($at);
  47 }
  48
  49 sub with_member_at {
  50   my ($self, $at, $value) = @_;
  51   if ($at =~ /^[0-9]+$/) {
  52     my @locals = @{$self->locals};
  53     $locals[$at] = $value;
  54     return $self->but(
  55       locals => \@locals
  56     );
  57   }
  58   return $self->but(
  59     globals => $self->globals->with_member_at($at, $value)
  60   );
  61 }
  62
  63 sub apply_updates {
  64   my ($self, @updates) = @_;
  65   my @events;
  66   my $scope = $self;
  67   ($scope, @events) = ($_->apply_to($scope), @events) for @updates;
  68   return ($scope, @events);
  69 }
  70
  71 1;