lib/DX/State.pm

   1 package DX::State;
   2
   3 use Return::MultiLevel qw(with_return);
   4 use DX::Op::FromCode;
   5 use Moo;
   6
   7 has next_op => (is => 'ro', required => 1);
   8
   9 has return_stack => (is => 'ro', required => 1);
  10
  11 has by_id => (is => 'ro', required => 1);
  12
  13 has scope => (is => 'ro', required => 1);
  14
  15 has last_choice => (is => 'ro', required => 1);
  16
  17 sub scope_var {
  18   my ($self, $name) = @_;
  19   $self->by_id->{$self->scope->{$name}};
  20 }
  21
  22 sub bind_stream_then {
  23   my ($self, $var, $stream, $then) = @_;
  24   warn "Binding ".$var->id." to $stream";
  25   my $bound = $var->with_stream($stream);
  26   $self->but(
  27     by_id => { %{$self->by_id}, $var->id => $bound },
  28     next_op => $then
  29   )->mark_choice($bound);
  30 }
  31
  32 sub mark_choice {
  33   my ($self, $var) = @_;
  34   $self->but(last_choice => [ $self, $var ]);
  35 }
  36
  37 sub backtrack {
  38   my ($self) = @_;
  39   my ($state, $var) = ($self);
  40   while (($state, $var) = @{$state->last_choice}) {
  41     $var->bound_value; $var->clear_bound_value;
  42     return $state->mark_choice($var) unless $var->bound_stream->is_exhausted;
  43   }
  44   if (our $No_Options_Handler) {
  45     $No_Options_Handler->(undef);
  46   }
  47   die "Out of options";
  48 }
  49
  50 sub then {
  51   my ($self, $then) = @_;
  52   $self->but(next_op => $then);
  53 }
  54
  55 sub run {
  56   my ($state) = @_;
  57   with_return {
  58     my ($return) = @_;
  59     local our $No_Options_Handler = $return;
  60     while (my $op = $state->next_op) {
  61       $state = $op->run($state);
  62     }
  63     return $state;
  64   }
  65 }
  66
  67 sub push_backtrack {
  68   $_[0]->then(DX::Op::FromCode->new(code => sub { $_[1]->backtrack }));
  69 }
  70
  71 sub but {
  72   my ($self, @but) = @_;
  73   $self->new(%$self, @but);
  74 }
  75
  76 1;