follow alternative rspace entries without backtracking, explicitly resolve

[scpubgit/DX.git] / lib / DX / QueryState.pm

diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index ac4039b..4be7b1c 100644 (file)
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -1,13 +1,11 @@
 package DX::QueryState;
 
-use Types::Standard qw(HashRef);
 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;
 
@@ -19,33 +17,21 @@ has proposition_sequence => (
   is => 'ro', isa => PropositionSequence, required => 1
 );
 
-has search_state => (
-  is => 'lazy', builder => sub {
-    $_[0]->new_search_state_for($_[0]->proposition_sequence)
-  },
+has search_process => (
+  is => 'lazy', isa => SearchProcess, builder => sub {
+    $_[0]->new_search_process_for($_[0]->proposition_sequence)
+  }, handles => { search_state => 'current_search_state' },
 );
 
-sub new_search_state_for {
+sub new_search_process_for {
   my ($self, $prop_seq) = @_;
   my @local_names = map { keys %{$_->introduced_names} }
                       @{$prop_seq->members};
   my $scope = DX::Scope->new(
     predicates => $self->predicates,
     globals => $self->globals,
-    locals => [
-      dict(
-        map +($_ => DX::Value::Unset->new(
-                      identity_path => [ 0, $_ ],
-                      action_builder => DX::ActionBuilder::UnsetValue->new(
-                        target_path => [ 0, $_ ],
-                      )
-                    )
-        ), @local_names
-      )
-    ],
-    lex_map => {
-      map +($_ => [ 0, $_ ]), @local_names
-    }
+    locals => [ dict() ],
+    lex_map => { }
   );
   my $hyp = DX::Hypothesis->new(
     scope => $scope,
@@ -58,23 +44,69 @@ sub new_search_state_for {
 }
 
 sub with_additional_proposition {
-  my ($self, $prop) = @_;
-  my $prop_seq = $self->proposition_sequence
-                      ->with_additional_proposition($prop);
-  my $sol_ss = $self->new_search_state_for($prop_seq)
+  my ($self, $new_prop) = @_;
+  my $old_prop_seq = $self->proposition_sequence;
+  my $new_prop_seq = $old_prop_seq->with_additional_proposition($new_prop);
+  my $old_ss = $self->search_process->current_search_state;
+  my %seen;
+  my $_munge; $_munge = sub {
+    my ($ss) = @_;
+    return $seen{$ss} ||= do {
+      my %but = (
+        decisions_taken => [
+          map [ $_->[0], $_->[1]->$_munge ], @{$ss->decisions_taken}
+        ]
+      );
+      if ($ss->propositions eq $old_prop_seq) {
+        $but{propositions} = $new_prop_seq;
+      }
+      foreach my $type (qw(on_solution_step on_exhaustion_step)) {
+        my $step = $ss->$type;
+        if ($step and $step->can('resume_search_state')) {
+          $but{$type}
+            = $seen{$step}
+            ||= $step->but(
+                  resume_search_state => $step->resume_search_state->$_munge
+                );
+        }
+      }
+      if ((my $next_step = $ss->next_step)->can('original_search_state')) {
+         $but{next_step}
+           = $seen{$next_step}
+           ||= $next_step->but(
+                 original_search_state
+                   => $next_step->original_search_state->$_munge
+               );
+      }
+       
+      $ss->but(%but);
+    };
+  };
+  my $munged_ss = $old_ss->$_munge;
+  undef($_munge);
+
+  my $new_ss = $munged_ss->but(
+    is_solution_state => 0,
+    next_step => DX::Step::ConsiderProposition->new(
+                   proposition => $new_prop
+                 ),
+  );
+
+  my $sol_sp = $self->search_process
+                    ->but(current_search_state => $new_ss)
                     ->find_solution;
-  die "No solution\n" unless $sol_ss;
+  die "No solution\n" unless $sol_sp;
   $self->but(
-    proposition_sequence => $prop_seq,
-    search_state => $sol_ss,
+    proposition_sequence => $new_prop_seq,
+    search_process => $sol_sp,
   );
 }
 
 sub with_forced_backtrack {
   my ($self) = @_;
-  my $next_ss = $self->search_state->find_next_solution;
+  my $next_ss = $self->search_process->find_next_solution;
   die "No next solution\n" unless $next_ss;
-  $self->but(search_state => $next_ss);
+  $self->but(search_process => $next_ss);
 }
 
 1;