pervasive type constraints

[scpubgit/DX.git] / lib / DX / Scope.pm

package DX::Scope;

use DX::Class;

has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);

has globals => (is => 'ro', isa => DictValue, required => 1);

has locals => (is => 'ro', isa => ArrayRef[DictValue], required => 1);

has lex_map => (is => 'ro', isa => HashRef[ArrayRef[Str]], required => 1);

#has known_facts => (is => 'ro', required => 1);

sub lookup_predicate {
  my ($self, $predicate) = @_;
  return $self->predicates->{$predicate} || die "No such predicate: $predicate";
}

sub lookup {
  my ($self, $symbol) = @_;
  if ($symbol =~ /^[_A-Z]/) {
    my @mapped = @{$self->lex_map->{$symbol}||[]}
      or die "No such name in scope: $symbol";
    my $targ = $self;
    $targ = $targ->get_member_at($_) for @mapped;
    return $targ;
  }
  return $self->globals->get_member_at($symbol)
   || die "No such name in scope: $symbol";
}

sub depth { $#{$_[0]->locals} }

sub prune_to {
  my ($self, $to) = @_;
  $self->but(locals => [ @{$self->locals}[0..$to] ]);
}

sub get_member_at {
  my ($self, $at) = @_;
  if ($at =~ /^[0-9]+$/) {
    return $self->locals->[$at];
  }
  return $self->globals->get_member_at($at);
}

sub with_member_at {
  my ($self, $at, $value) = @_;
  if ($at =~ /^[0-9]+$/) {
    my @locals = @{$self->locals};
    $locals[$at] = $value;
    return $self->but(
      locals => \@locals
    );
  }
  return $self->but(
    globals => $self->globals->with_member_at($at, $value)
  );
}

sub apply_updates {
  my ($self, @updates) = @_;
  my @events;
  my $scope = $self;
  ($scope, @events) = ($_->apply_to($scope), @events) for @updates;
  return ($scope, @events);
}

1;