format aperture in backtrack trace

[scpubgit/DX.git] / lib / DX / Step / Backtrack.pm

diff --git a/lib/DX/Step/Backtrack.pm b/lib/DX/Step/Backtrack.pm
index 865073a..0da00a6 100644 (file)
--- a/lib/DX/Step/Backtrack.pm
+++ b/lib/DX/Step/Backtrack.pm
@@ -1,25 +1,76 @@
 package DX::Step::Backtrack;
 
+use DX::DependencyMap;
+use DX::Utils qw(format_deps compact_deps);
 use DX::Class;
 
 with 'DX::Role::Step';
 
-#has resolution_space => (is => 'ro', isa => ResolutionSpace, required => 1);
+has resolution_space => (is => 'ro', isa => ResolutionSpace, required => 1);
 
 sub apply_to {
   my ($self, $ss) = @_;
-  trace backtrack => [ statement => [ [ symbol => 'backtrack' ] ] ];
-  foreach my $adj (@{$ss->decisions_taken}) {
+  my $rspace = $self->resolution_space;
+  trace backtrack => [ statement => [
+    [ symbol => 'backtrack' ],
+    [ 'enter_block' ]
+  ] ];
+  trace backtrack => [ word_and_body => [
+    'failure_dependencies',
+    format_deps($rspace->geometry_depends_on)
+  ] ];
+  my $dmap = DX::DependencyMap->new_empty
+                              ->with_dependencies_for(
+                                  backtrack => $rspace->geometry_depends_on
+                                );
+  DECISION: foreach my $adj (@{$ss->decisions_taken}) {
     my ($rspace_was, $ss_was) = @$adj;
-    trace rspace => [ statement => [
-      [ symbol => 'remaining' ],
-      @{$rspace_was->remaining_resolution_space->for_deparse->[1]}
+    trace backtrack => [ statement => [
+      [ symbol => 'decision' ],
+      [ pairs => [
+        [ for => $rspace_was->proposition, ],
+        [ aperture => [ block => [
+            map [ statement => [
+              [ symbol => (split '::', ${$_->[0]})[-1] ],
+              [ value_path => [ @{$_}[1..$#$_] ] ],
+            ] ], @{$rspace_was->aperture}
+          ] ] ]
+      ] ]
     ] ];
-    return $ss_was->but(
-      next_step => $rspace_was->remaining_resolution_space->next_step
-    );
+    foreach my $event (@{$rspace_was->aperture}) {
+      if ($dmap->dependents_of($event)) {
+        my $remain = $rspace_was->remaining_resolution_space;
+        if (@{$remain->members}) {
+          trace backtrack => [ statement => [
+            [ symbol => 'found_alternative' ]
+          ] ];
+          trace backtrack => [ 'leave_block' ];
+          return $ss_was->but(
+            next_step => $remain->with_geometry_dependencies(
+                                  $dmap->dependencies_for('backtrack')
+                               )->next_step
+          );
+        }
+        $dmap = $dmap->with_dependencies_for(
+          backtrack => $rspace_was->geometry_depends_on
+        );
+        trace backtrack => [ word_and_body => [
+          'failure_dependencies',
+          format_deps(compact_deps($dmap->dependencies_for('backtrack')))
+        ] ];
+        next DECISION;
+      }
+    }
+    trace backtrack => [ statement => [ [ symbol => 'non_relevant' ] ] ];
   }
-  return $ss->but(next_step => $ss->on_exhaustion_step);
+  trace backtrack => [ statement => [ [ symbol => 'exhaustion' ] ] ];
+  trace backtrack => [ 'leave_block' ];
+  return $ss->but(
+    next_step
+      => $ss->on_exhaustion_step->but(
+           exhaustion_depends_on => $dmap->dependencies_for('backtrack')
+         )
+  );
 }
 
 1;