first test for observer code

[scpubgit/DKit.git] / lib / DX / State.pm

diff --git a/lib/DX/State.pm b/lib/DX/State.pm
index 2bf0f07..7ec2e1b 100644 (file)
--- a/lib/DX/State.pm
+++ b/lib/DX/State.pm
@@ -19,6 +19,16 @@ sub scope_var {
   $self->by_id->{$self->scope->{$name}};
 }
 
+sub bind_var_then {
+  my ($self, $var, $value, $then) = @_;
+  warn "Binding ".$var->id." to $value";
+  my $bound = $var->with_value($value);
+  $self->but(
+    by_id => { %{$self->by_id}, $var->id => $bound },
+    next_op => $then
+  );
+}
+
 sub bind_stream_then {
   my ($self, $var, $stream, $then) = @_;
   warn "Binding ".$var->id." to $stream";
@@ -41,10 +51,7 @@ sub backtrack {
     $var->bound_value; $var->clear_bound_value;
     return $state->mark_choice($var) unless $var->bound_stream->is_exhausted;
   }
-  if (our $No_Options_Handler) {
-    $No_Options_Handler->(undef);
-  }
-  die "Out of options";
+  $self->return_from_run(undef);
 }
 
 sub then {
@@ -52,11 +59,16 @@ sub then {
   $self->but(next_op => $then);
 }
 
+sub return_from_run {
+  my (undef, $return) = @_;
+  (our $Nonlocal_Return)->($return);
+}
+
 sub run {
   my ($state) = @_;
   with_return {
     my ($return) = @_;
-    local our $No_Options_Handler = $return;
+    local our $Nonlocal_Return = $return;
     while (my $op = $state->next_op) {
       $state = $op->run($state);
     }
@@ -73,4 +85,19 @@ sub but {
   $self->new(%$self, @but);
 }
 
+sub pop_return_stack {
+  my ($self) = @_;
+  my @stack = @{$self->return_stack};
+  my $top = pop @stack;
+  $self->but(return_stack => \@stack, next_op => $top);
+}
+
+sub push_return_then {
+  my ($self, $return, $then) = @_;
+  $self->but(
+    return_stack => [ @{$self->return_stack}, $return ],
+    next_op => $then
+  );
+}
+
 1;