From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 14 Apr 2018 20:14:10 +0000 (+0000)
Subject: add exhaustionstep and resumesearch concepts
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDX.git;a=commitdiff_plain;h=ae6f4d03d4db3ce67f1500630cf9d78a5c63dc53

add exhaustionstep and resumesearch concepts
---

diff --git a/fragment.output/btdemo b/fragment.output/btdemo
index 296324b..0ed4020 100644
--- a/fragment.output/btdemo
+++ b/fragment.output/btdemo
@@ -18,6 +18,7 @@ resolve {
     actions { SetValue 0.X {{ a 1 b 2 c 3 }} }
     depends_on { CONTENTS_OF 0.X }
 }
+solution
 SetValue 0.X {{ a 1 b 2 c 3 }}
 ? eq ?Y {{ d 1 e 2 f 3 }}
 consider eq ?Y {{ d 1 e 2 f 3 }}
@@ -37,6 +38,7 @@ resolve {
     actions { SetValue 0.Y {{ d 1 e 2 f 3 }} }
     depends_on { CONTENTS_OF 0.Y }
 }
+solution
 SetValue 0.Y {{ d 1 e 2 f 3 }}
 ? member_at X ?XKey ?XValue
 consider member_at X ?XKey ?XValue
@@ -60,6 +62,7 @@ resolve {
     actions { SetValue 0.XKey 'a'; BindValue 0.XValue 0.X.a }
     depends_on { CONTENTS_OF 0.X.a; CONTENTS_OF 0.XKey; CONTENTS_OF 0.XValue }
 }
+solution
 SetValue 0.XKey 'a'
 BindValue 0.XValue 0.X.a
 ? member_at Y ?YKey ?YValue
@@ -84,6 +87,7 @@ resolve {
     actions { SetValue 0.YKey 'd'; BindValue 0.YValue 0.Y.d }
     depends_on { CONTENTS_OF 0.Y.d; CONTENTS_OF 0.YKey; CONTENTS_OF 0.YValue }
 }
+solution
 SetValue 0.YKey 'd'
 BindValue 0.YValue 0.Y.d
 ? eq XValue 2
@@ -336,6 +340,7 @@ resolution_space {
     members { resolution { veracity_depends_on { CONTENTS_OF 0.XValue } } }
 }
 resolve { proposition eq XValue 2; depends_on { CONTENTS_OF 0.XValue } }
+solution
 ? eq YValue 2
 consider eq YValue 2
 resolution_space {
@@ -432,22 +437,9 @@ resolution_space {
     members { resolution { veracity_depends_on { CONTENTS_OF 0.YValue } } }
 }
 resolve { proposition eq YValue 2; depends_on { CONTENTS_OF 0.YValue } }
+solution
 ? ...
-backtrack
-remaining resolution_space {
-    proposition eq YValue 2
-    geometry_depends_on { CONTENTS_OF 0.YValue }
-    aperture { VALUE_SET 0.YValue; VALUE_SET 0.Y.e }
-    members {  }
-}
-backtrack
-remaining resolution_space {
-    proposition eq XValue 2
-    geometry_depends_on { CONTENTS_OF 0.XValue }
-    aperture { VALUE_SET 0.XValue; VALUE_SET 0.X.b }
-    members {  }
-}
-backtrack
+resume
 remaining resolution_space {
     proposition member_at Y ?YKey ?YValue
     geometry_depends_on { INDICES_OF 0.Y; TYPE_OF 0.YKey; TYPE_OF 0.YValue }
diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index aa5fede..ac247c1 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -4,9 +4,8 @@ use DX::Scope;
 use DX::Hypothesis;
 use DX::SearchProcess;
 use DX::ResolvedPropositionSet;
-use DX::Value::Unset;
-use DX::ActionBuilder::UnsetValue;
 use DX::ActionPolicy::Allow;
+use DX::Step::MarkAsExhaustion;
 use DX::Utils qw(:builders);
 use DX::Class;
 
diff --git a/lib/DX/SearchProcess.pm b/lib/DX/SearchProcess.pm
index e22eaa3..3072313 100644
--- a/lib/DX/SearchProcess.pm
+++ b/lib/DX/SearchProcess.pm
@@ -45,8 +45,8 @@ sub force_backtrack {
 
 sub find_next_solution {
   my ($self) = @_;
-  return undef unless my $bt = $self->force_backtrack;
-  return $bt->find_solution;
+  my $state = $self->current_search_state->with_one_step;
+  return $self->but(current_search_state => $state)->find_solution;
 }
 
 1;
diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm
index 3ab4a66..415b22a 100644
--- a/lib/DX/SearchState.pm
+++ b/lib/DX/SearchState.pm
@@ -15,6 +15,8 @@ has decisions_taken => (is => 'ro', isa => DecisionList, required => 1);
 
 has is_solution_state => (is => 'ro', isa => Bool, required => 1);
 
+has is_exhaustion_state => (is => 'ro', isa => Bool, required => 1);
+
 has on_exhaustion_step => (is => 'ro', isa => Maybe[Step], required => 1);
 
 has on_solution_step => (is => 'ro', isa => Maybe[Step], required => 1);
@@ -40,9 +42,10 @@ sub new_for {
           ),
           is_solution_state => 0,
         )
-      : ( next_step => undef, is_solution_state => 1 )
+      : ( next_step => DX::Step::MarkAsExhaustion->new, is_solution_state => 1 )
     ),
-    on_exhaustion_step => undef,
+    is_exhaustion_state => 0,
+    on_exhaustion_step => DX::Step::MarkAsExhaustion->new,
     on_solution_step => DX::Step::MarkAsSolution->new,
   );
 }
diff --git a/lib/DX/Step/ConsiderProposition.pm b/lib/DX/Step/ConsiderProposition.pm
index 386048c..c131791 100644
--- a/lib/DX/Step/ConsiderProposition.pm
+++ b/lib/DX/Step/ConsiderProposition.pm
@@ -1,5 +1,7 @@
 package DX::Step::ConsiderProposition;
 
+use DX::Value::Unset;
+use DX::ActionBuilder::UnsetValue;
 use DX::Class;
 
 with 'DX::Role::Step';
diff --git a/lib/DX/Step/EnterRecheck.pm b/lib/DX/Step/EnterRecheck.pm
index d2d44ba..ba9d125 100644
--- a/lib/DX/Step/EnterRecheck.pm
+++ b/lib/DX/Step/EnterRecheck.pm
@@ -63,6 +63,7 @@ sub apply_to {
                    proposition => $prop,
                  ),
     is_solution_state => 0,
+    is_exhaustion_state => 0,
     on_solution_step => DX::Step::CompleteRecheck->new(
       resume_search_state => $old_ss->but(next_step => $next_step),
       was_recheck_for => $prop,
diff --git a/lib/DX/Step/MarkAsExhaustion.pm b/lib/DX/Step/MarkAsExhaustion.pm
new file mode 100644
index 0000000..cd58fd4
--- /dev/null
+++ b/lib/DX/Step/MarkAsExhaustion.pm
@@ -0,0 +1,16 @@
+package DX::Step::MarkAsExhaustion;
+
+use DX::Class;
+
+with 'DX::Role::Step';
+
+sub apply_to {
+  my ($self, $ss) = @_;
+  $ss->but(
+    is_solution_state => 0,
+    is_exhaustion_state => 1,
+    next_step => undef,
+  );
+}
+
+1;
diff --git a/lib/DX/Step/MarkAsSolution.pm b/lib/DX/Step/MarkAsSolution.pm
index e2fc7e3..37d59f5 100644
--- a/lib/DX/Step/MarkAsSolution.pm
+++ b/lib/DX/Step/MarkAsSolution.pm
@@ -1,14 +1,16 @@
 package DX::Step::MarkAsSolution;
 
+use DX::Step::ResumeSearch;
 use DX::Class;
 
 with 'DX::Role::Step';
 
 sub apply_to {
   my ($self, $ss) = @_;
+  trace solution => [ statement => [ [ symbol => 'solution' ] ] ];
   $ss->but(
     is_solution_state => 1,
-    next_step => DX::Step::Backtrack->new
+    next_step => DX::Step::ResumeSearch->new
   );
 }
 
diff --git a/lib/DX/Step/ResumeSearch.pm b/lib/DX/Step/ResumeSearch.pm
new file mode 100644
index 0000000..90693cc
--- /dev/null
+++ b/lib/DX/Step/ResumeSearch.pm
@@ -0,0 +1,28 @@
+package DX::Step::ResumeSearch;
+
+use DX::Class;
+
+with 'DX::Role::Step';
+
+sub apply_to {
+  my ($self, $ss) = @_;
+  trace resume => [ statement => [ [ symbol => 'resume' ] ] ];
+  foreach my $adj (@{$ss->decisions_taken}) {
+    my ($rspace_was, $ss_was) = @$adj;
+    next unless @{$rspace_was->remaining_resolution_space->members};
+    trace rspace => [ statement => [
+      [ symbol => 'remaining' ],
+      @{$rspace_was->remaining_resolution_space->for_deparse->[1]}
+    ] ];
+    return $ss_was->but(
+      is_solution_state => 0,
+      next_step => $rspace_was->remaining_resolution_space->next_step
+    );
+  }
+  return $ss->but(
+    is_solution_state => 0,
+    next_step => $ss->on_exhaustion_step
+  );
+}
+
+1;