Commit | Line | Data |
60cda014 |
1 | package DX::State; |
2 | |
5622b4df |
3 | use Return::MultiLevel qw(with_return); |
4 | use DX::Op::FromCode; |
60cda014 |
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->new(%$self, |
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->new(%$self, |
35 | last_choice => [ $self, $var ] |
36 | ); |
37 | } |
38 | |
39 | sub backtrack { |
40 | my ($self) = @_; |
94565614 |
41 | my ($state, $var) = ($self); |
42 | while (($state, $var) = @{$state->last_choice}) { |
60cda014 |
43 | $var->bound_value; $var->clear_bound_value; |
94565614 |
44 | return $state->mark_choice($var) unless $var->bound_stream->is_exhausted; |
60cda014 |
45 | } |
5622b4df |
46 | if (our $No_Options_Handler) { |
47 | $No_Options_Handler->(undef); |
48 | } |
60cda014 |
49 | die "Out of options"; |
50 | } |
51 | |
52 | sub then { |
53 | my ($self, $then) = @_; |
54 | $self->new(%$self, next_op => $then); |
55 | } |
56 | |
71d26209 |
57 | sub select_next_op { |
58 | my ($self) = @_; |
59 | return $self->next_op || do { |
60 | if (my @stack = @{$self->return_stack}) { |
61 | my $top = pop @stack; |
62 | DX::Op::FromCode->new( |
63 | code => sub { |
64 | $_[1]->new(%{$_[1]}, return_stack => \@stack, next_op => $top) |
65 | } |
66 | ); |
67 | } else { |
68 | undef; |
69 | } |
70 | }; |
71 | } |
72 | |
94565614 |
73 | sub run { |
74 | my ($state) = @_; |
5622b4df |
75 | with_return { |
76 | my ($return) = @_; |
77 | local our $No_Options_Handler = $return; |
71d26209 |
78 | while (my $op = $state->select_next_op) { |
5622b4df |
79 | $state = $op->run($state); |
80 | } |
81 | return $state; |
94565614 |
82 | } |
5622b4df |
83 | } |
84 | |
85 | sub push_backtrack { |
86 | $_[0]->then(DX::Op::FromCode->new(code => sub { $_[1]->backtrack })); |
94565614 |
87 | } |
88 | |
60cda014 |
89 | 1; |