move backtracking into a stream
Matt S Trout [Mon, 20 Jan 2014 10:21:43 +0000 (10:21 +0000)]
lib/DX/ResultStream.pm [new file with mode: 0644]
lib/DX/State.pm
t/basic.t

diff --git a/lib/DX/ResultStream.pm b/lib/DX/ResultStream.pm
new file mode 100644 (file)
index 0000000..aa54025
--- /dev/null
@@ -0,0 +1,27 @@
+package DX::ResultStream;
+
+use Moo;
+
+has for_state => (is => 'ro', required => 1);
+
+has _current_state => (is => 'rw');
+
+has is_exhausted => (is => 'rwp');
+
+sub next {
+  my ($self) = @_;
+  return if $self->is_exhausted;
+  my $start_state = do {
+    if (my $cur = $self->_current_state) {
+      $cur->backtrack;
+    } else {
+      $self->for_state
+    }
+  };
+  my $state = $self->_current_state($start_state->run);
+  return +{
+    map +($_ => $state->scope_var($_)->bound_value), keys %{$state->scope}
+  };
+}
+
+1;
index f273ddb..0ee431c 100644 (file)
@@ -36,9 +36,10 @@ sub mark_choice {
 
 sub backtrack {
   my ($self) = @_;
-  while (my ($state, $var) = @{$self->last_choice}) {
+  my ($state, $var) = ($self);
+  while (($state, $var) = @{$state->last_choice}) {
     $var->bound_value; $var->clear_bound_value;
-    return $state unless $var->bound_stream->is_exhausted;
+    return $state->mark_choice($var) unless $var->bound_stream->is_exhausted;
   }
   die "Out of options";
 }
@@ -48,4 +49,12 @@ sub then {
   $self->new(%$self, next_op => $then);
 }
 
+sub run {
+  my ($state) = @_;
+  while (my $op = $state->next_op) {
+    $state = $op->run($state);
+  }
+  return $state;
+}
+
 1;
index 809c211..5539ff4 100644 (file)
--- a/t/basic.t
+++ b/t/basic.t
@@ -2,8 +2,10 @@ use strictures 1;
 use Test::More;
 use aliased 'DX::Op::FromCode';
 use aliased 'DX::ArrayStream';
+use DX::ResultStream;
 use DX::Var;
 use DX::State;
+use Test::Exception;
 
 my @servers = qw(
   kitty.scsys.co.uk
@@ -59,11 +61,11 @@ my $state = DX::State->new(
   last_choice => []
 );
 
-while (my $op = $state->next_op) {
-  $state = $op->run($state);
-  ::Dwarn($state);
-}
+my $stream = DX::ResultStream->new(for_state => $state);
+
+is($stream->next->{'S'}, $_)
+  for qw(jim.example.com joe.example.com bob.example.com);
 
-is($state->scope_var('S')->bound_value, 'jim.example.com');
+dies_ok { $stream->next } 'No more';
 
 done_testing;