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 | |
b40d5c51 |
22 | sub bind_var_then { |
23 | my ($self, $var, $value, $then) = @_; |
24 | warn "Binding ".$var->id." to $value"; |
25 | my $bound = $var->with_value($value); |
26 | $self->but( |
27 | by_id => { %{$self->by_id}, $var->id => $bound }, |
28 | next_op => $then |
29 | ); |
30 | } |
31 | |
60cda014 |
32 | sub bind_stream_then { |
33 | my ($self, $var, $stream, $then) = @_; |
34 | warn "Binding ".$var->id." to $stream"; |
35 | my $bound = $var->with_stream($stream); |
03079510 |
36 | $self->but( |
60cda014 |
37 | by_id => { %{$self->by_id}, $var->id => $bound }, |
38 | next_op => $then |
39 | )->mark_choice($bound); |
40 | } |
41 | |
42 | sub mark_choice { |
43 | my ($self, $var) = @_; |
03079510 |
44 | $self->but(last_choice => [ $self, $var ]); |
60cda014 |
45 | } |
46 | |
47 | sub backtrack { |
48 | my ($self) = @_; |
94565614 |
49 | my ($state, $var) = ($self); |
50 | while (($state, $var) = @{$state->last_choice}) { |
60cda014 |
51 | $var->bound_value; $var->clear_bound_value; |
94565614 |
52 | return $state->mark_choice($var) unless $var->bound_stream->is_exhausted; |
60cda014 |
53 | } |
b40d5c51 |
54 | $self->return_from_run(undef); |
60cda014 |
55 | } |
56 | |
57 | sub then { |
58 | my ($self, $then) = @_; |
03079510 |
59 | $self->but(next_op => $then); |
60cda014 |
60 | } |
61 | |
b40d5c51 |
62 | sub return_from_run { |
63 | my (undef, $return) = @_; |
64 | (our $Nonlocal_Return)->($return); |
65 | } |
66 | |
94565614 |
67 | sub run { |
68 | my ($state) = @_; |
5622b4df |
69 | with_return { |
70 | my ($return) = @_; |
b40d5c51 |
71 | local our $Nonlocal_Return = $return; |
54817920 |
72 | while (my $op = $state->next_op) { |
5622b4df |
73 | $state = $op->run($state); |
74 | } |
75 | return $state; |
94565614 |
76 | } |
5622b4df |
77 | } |
78 | |
79 | sub push_backtrack { |
80 | $_[0]->then(DX::Op::FromCode->new(code => sub { $_[1]->backtrack })); |
94565614 |
81 | } |
82 | |
03079510 |
83 | sub but { |
84 | my ($self, @but) = @_; |
85 | $self->new(%$self, @but); |
86 | } |
87 | |
b40d5c51 |
88 | sub pop_return_stack { |
89 | my ($self) = @_; |
90 | my @stack = @{$self->return_stack}; |
91 | my $top = pop @stack; |
92 | $self->but(return_stack => \@stack, next_op => $top); |
93 | } |
94 | |
95 | sub push_return_then { |
96 | my ($self, $return, $then) = @_; |
97 | $self->but( |
98 | return_stack => [ @{$self->return_stack}, $return ], |
99 | next_op => $then |
100 | ); |
101 | } |
102 | |
60cda014 |
103 | 1; |