Commit | Line | Data |
60cda014 |
1 | package DX::State; |
2 | |
5622b4df |
3 | use Return::MultiLevel qw(with_return); |
4 | use DX::Op::FromCode; |
b373788e |
5 | use Scalar::Util qw(blessed); |
60cda014 |
6 | use Moo; |
7 | |
8 | has next_op => (is => 'ro', required => 1); |
9 | |
10 | has return_stack => (is => 'ro', required => 1); |
11 | |
12 | has by_id => (is => 'ro', required => 1); |
13 | |
14 | has scope => (is => 'ro', required => 1); |
15 | |
16 | has last_choice => (is => 'ro', required => 1); |
17 | |
b373788e |
18 | has id_gen => (is => 'ro', default => sub { {} }); |
19 | |
b40e416a |
20 | has rule_set => (is => 'ro'); |
21 | |
22 | has facts => (is => 'ro'); |
23 | |
60cda014 |
24 | sub scope_var { |
25 | my ($self, $name) = @_; |
26 | $self->by_id->{$self->scope->{$name}}; |
27 | } |
28 | |
b373788e |
29 | sub allocate_var { |
30 | my ($self, $name, $var) = @_; |
31 | my $id = join('_', $name, ++($self->id_gen->{$name})); |
32 | DX::Var->new(id => $id, %$var); |
33 | } |
34 | |
35 | sub assign_vars { |
36 | my ($self, %vars) = @_; |
37 | my %by_id = %{$self->by_id}; |
b40e416a |
38 | my $state = $self->but(id_gen => { %{$self->id_gen} }); |
b373788e |
39 | foreach my $name (keys %vars) { |
b373788e |
40 | unless (blessed($vars{$name})) { |
b40e416a |
41 | my $var = $vars{$name} = $state->allocate_var($name, $vars{$name}); |
b373788e |
42 | $by_id{$var->id} = $var; |
43 | } |
44 | } |
b40e416a |
45 | $state->but( |
b373788e |
46 | by_id => \%by_id, |
47 | scope => { %{$self->scope}, map +($_ => $vars{$_}->id), keys %vars } |
48 | ); |
49 | } |
50 | |
b40d5c51 |
51 | sub bind_var_then { |
52 | my ($self, $var, $value, $then) = @_; |
b40d5c51 |
53 | my $bound = $var->with_value($value); |
54 | $self->but( |
55 | by_id => { %{$self->by_id}, $var->id => $bound }, |
56 | next_op => $then |
57 | ); |
58 | } |
59 | |
60cda014 |
60 | sub bind_stream_then { |
61 | my ($self, $var, $stream, $then) = @_; |
60cda014 |
62 | my $bound = $var->with_stream($stream); |
03079510 |
63 | $self->but( |
60cda014 |
64 | by_id => { %{$self->by_id}, $var->id => $bound }, |
65 | next_op => $then |
66 | )->mark_choice($bound); |
67 | } |
68 | |
69 | sub mark_choice { |
70 | my ($self, $var) = @_; |
03079510 |
71 | $self->but(last_choice => [ $self, $var ]); |
60cda014 |
72 | } |
73 | |
74 | sub backtrack { |
75 | my ($self) = @_; |
94565614 |
76 | my ($state, $var) = ($self); |
77 | while (($state, $var) = @{$state->last_choice}) { |
60cda014 |
78 | $var->bound_value; $var->clear_bound_value; |
94565614 |
79 | return $state->mark_choice($var) unless $var->bound_stream->is_exhausted; |
60cda014 |
80 | } |
b40d5c51 |
81 | $self->return_from_run(undef); |
60cda014 |
82 | } |
83 | |
84 | sub then { |
85 | my ($self, $then) = @_; |
03079510 |
86 | $self->but(next_op => $then); |
60cda014 |
87 | } |
88 | |
b40d5c51 |
89 | sub return_from_run { |
90 | my (undef, $return) = @_; |
91 | (our $Nonlocal_Return)->($return); |
92 | } |
93 | |
94565614 |
94 | sub run { |
95 | my ($state) = @_; |
5622b4df |
96 | with_return { |
97 | my ($return) = @_; |
b40d5c51 |
98 | local our $Nonlocal_Return = $return; |
54817920 |
99 | while (my $op = $state->next_op) { |
5622b4df |
100 | $state = $op->run($state); |
101 | } |
102 | return $state; |
94565614 |
103 | } |
5622b4df |
104 | } |
105 | |
106 | sub push_backtrack { |
107 | $_[0]->then(DX::Op::FromCode->new(code => sub { $_[1]->backtrack })); |
94565614 |
108 | } |
109 | |
03079510 |
110 | sub but { |
111 | my ($self, @but) = @_; |
112 | $self->new(%$self, @but); |
113 | } |
114 | |
b40d5c51 |
115 | sub pop_return_stack { |
116 | my ($self) = @_; |
117 | my @stack = @{$self->return_stack}; |
118 | my $top = pop @stack; |
119 | $self->but(return_stack => \@stack, next_op => $top); |
120 | } |
121 | |
122 | sub push_return_then { |
123 | my ($self, $return, $then) = @_; |
124 | $self->but( |
125 | return_stack => [ @{$self->return_stack}, $return ], |
126 | next_op => $then |
127 | ); |
128 | } |
129 | |
60cda014 |
130 | 1; |