From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 26 Mar 2016 04:32:17 +0000 (+0000)
Subject: restructure searching so with_one_step is actually one step
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e647e41754e354b48b8abf1dacee5a5f16a2aae9;p=scpubgit%2FDX.git

restructure searching so with_one_step is actually one step
---

diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index 496b983..f7c030a 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -55,10 +55,7 @@ sub new_search_state_for {
     action_applications => [],
     action_policy => DX::ActionPolicy::Allow->new,
   );
-  return DX::SearchState->new(
-    current_hypothesis => $hyp,
-    alternatives => [],
-  );
+  return DX::SearchState->new_for($hyp);
 }
 
 sub with_additional_proposition {
diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm
index 3daca33..1053f48 100644
--- a/lib/DX/SearchState.pm
+++ b/lib/DX/SearchState.pm
@@ -1,11 +1,12 @@
 package DX::SearchState;
 
 use Types::Standard qw(Maybe);
+use DX::Step::InvokeNextPredicate;
 use DX::Class;
 
 has current_hypothesis => (is => 'ro', isa => Hypothesis, required => 1);
 
-has resume_step => (is => 'ro', isa => Maybe[Step]);
+has next_step => (is => 'ro', isa => Maybe[Step]);
 
 has alternatives => (is => 'ro', isa => AlternativeList, required => 1);
 
@@ -14,37 +15,38 @@ sub new_for {
   $class->new(
     current_hypothesis => $hyp,
     alternatives => [],
+    next_step => DX::Step::InvokeNextPredicate->new,
   );
 }
 
 sub with_one_step {
   my ($self) = @_;
   my $hyp = $self->current_hypothesis;
-  my $step = $self->resume_step
-             || $hyp->head_proposition->resolve_for($hyp->scope);
-  my @alt = @{$self->alternatives};
-  HYP: while ($hyp) {
-    STEP: while ($step) {
-      my ($new_hyp, $alt_step) = $step->apply_to($hyp);
-      if ($new_hyp) {
-        return $self->but(
-          current_hypothesis => $new_hyp,
-          alternatives => [
-            ($alt_step
-              ? [ $hyp, $alt_step ]
-              : ()),
-            @alt
-          ],
-          resume_step => undef,
-        );
-      }
-      trace 'search.backtrack.alt' => $alt_step;
-      $step = $alt_step;
-    }
-    ($hyp, $step) = @{shift(@alt)||[]};
-    trace 'search.backtrack.rewind_to' => $step;
+  return undef unless my $step = $self->next_step;
+  my ($first_alt, @rest_alt) = my @alt = @{$self->alternatives};
+  my ($new_hyp, $alt_step) = $step->apply_to($hyp);
+  if ($new_hyp) {
+    return $self->but(
+      current_hypothesis => $new_hyp,
+      alternatives => [
+        ($alt_step
+          ? [ $hyp, $alt_step ]
+          : ()),
+        @alt
+      ],
+      next_step => DX::Step::InvokeNextPredicate->new,
+    );
   }
-  return undef;
+  if ($alt_step) {
+    return $self->but(next_step => $alt_step);
+  }
+  return undef unless $first_alt;
+  trace 'search.backtrack.rewind_to' => $first_alt->[1];
+  return $self->but(
+    current_hypothesis => $first_alt->[0],
+    alternatives => \@rest_alt,
+    next_step => $first_alt->[1],
+  );
 }
 
 sub find_solution {
@@ -63,7 +65,7 @@ sub force_backtrack {
   trace 'search.backtrack.forced' => $first_alt->[0];
   return ref($self)->new(
     current_hypothesis => $first_alt->[0],
-    resume_step => $first_alt->[1],
+    next_step => $first_alt->[1],
     alternatives => \@rest_alt
   );
 }
diff --git a/lib/DX/Step/InvokeNextPredicate.pm b/lib/DX/Step/InvokeNextPredicate.pm
new file mode 100644
index 0000000..f4a68dd
--- /dev/null
+++ b/lib/DX/Step/InvokeNextPredicate.pm
@@ -0,0 +1,12 @@
+package DX::Step::InvokeNextPredicate;
+
+use DX::Class;
+
+with 'DX::Role::Step';
+
+sub apply_to {
+  my ($self, $hyp) = @_;
+  return (undef, $hyp->head_proposition->resolve_for($hyp->scope));
+}
+
+1;