move backtracking into a stream
[scpubgit/DKit.git] / lib / DX / State.pm
CommitLineData
60cda014 1package DX::State;
2
3use Moo;
4
5has next_op => (is => 'ro', required => 1);
6
7has return_stack => (is => 'ro', required => 1);
8
9has by_id => (is => 'ro', required => 1);
10
11has scope => (is => 'ro', required => 1);
12
13has last_choice => (is => 'ro', required => 1);
14
15sub scope_var {
16 my ($self, $name) = @_;
17 $self->by_id->{$self->scope->{$name}};
18}
19
20sub bind_stream_then {
21 my ($self, $var, $stream, $then) = @_;
22 warn "Binding ".$var->id." to $stream";
23 my $bound = $var->with_stream($stream);
24 $self->new(%$self,
25 by_id => { %{$self->by_id}, $var->id => $bound },
26 next_op => $then
27 )->mark_choice($bound);
28}
29
30sub mark_choice {
31 my ($self, $var) = @_;
32 $self->new(%$self,
33 last_choice => [ $self, $var ]
34 );
35}
36
37sub backtrack {
38 my ($self) = @_;
94565614 39 my ($state, $var) = ($self);
40 while (($state, $var) = @{$state->last_choice}) {
60cda014 41 $var->bound_value; $var->clear_bound_value;
94565614 42 return $state->mark_choice($var) unless $var->bound_stream->is_exhausted;
60cda014 43 }
44 die "Out of options";
45}
46
47sub then {
48 my ($self, $then) = @_;
49 $self->new(%$self, next_op => $then);
50}
51
94565614 52sub run {
53 my ($state) = @_;
54 while (my $op = $state->next_op) {
55 $state = $op->run($state);
56 }
57 return $state;
58}
59
60cda014 601;