From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 2 Mar 2018 22:06:33 +0000 (+0000)
Subject: add some basic tracing using the new deparser
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b6cab1b3b47f9b24e7cde2a512270d0cad63150;p=scpubgit%2FDX.git

add some basic tracing using the new deparser
---

diff --git a/lib/DX/Deparse.pm b/lib/DX/Deparse.pm
index 74d8eb3..a718678 100644
--- a/lib/DX/Deparse.pm
+++ b/lib/DX/Deparse.pm
@@ -1,6 +1,7 @@
 package DX::Deparse;
 
 use Scalar::Util qw(blessed);
+use curry;
 use DX::Class;
 
 sub indent_by { '    ' }
diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm
index ced6067..bb0cb10 100644
--- a/lib/DX/SearchState.pm
+++ b/lib/DX/SearchState.pm
@@ -51,7 +51,7 @@ sub new_for {
 sub with_one_step {
   my ($self) = @_;
   return undef unless my $step = $self->next_step;
-  trace step => $step;
+  #trace step => $step;
   return $step->apply_to($self);
 }
 
diff --git a/lib/DX/ShellState.pm b/lib/DX/ShellState.pm
index 118b7cf..8ddaab0 100644
--- a/lib/DX/ShellState.pm
+++ b/lib/DX/ShellState.pm
@@ -27,7 +27,7 @@ sub trace_sub {
     return unless $self->trace_these->{$part};
     my $dp = deparse($thing);
     $dp =~ s/\n$//;
-    warn "${tag}: ${dp}\n";
+    warn "${dp}\n";
   }
 }
 
diff --git a/lib/DX/Step/Backtrack.pm b/lib/DX/Step/Backtrack.pm
index 047b693..d14ca2f 100644
--- a/lib/DX/Step/Backtrack.pm
+++ b/lib/DX/Step/Backtrack.pm
@@ -6,6 +6,7 @@ with 'DX::Role::Step';
 
 sub apply_to {
   my ($self, $ss) = @_;
+  trace backtrack => [ statement => [ [ symbol => 'backtrack' ] ] ];
   foreach my $adj (@{$ss->adjustments_made}) {
     my ($step_was, $ss_was) = @$adj;
     if (my $alt = $step_was->alternative_step) {
diff --git a/lib/DX/Step/CompleteRecheck.pm b/lib/DX/Step/CompleteRecheck.pm
index 2c0a76e..f74f90c 100644
--- a/lib/DX/Step/CompleteRecheck.pm
+++ b/lib/DX/Step/CompleteRecheck.pm
@@ -11,6 +11,8 @@ has resume_search_state => (is => 'ro', isa => SearchState, required => 1);
 sub apply_to {
   my ($self, $ss) = @_;
 
+  trace recheck => [ statement => [ [ symbol => 'complete_recheck' ] ] ];
+
   my $prop = $self->was_recheck_for;
   my $re_ss = $self->resume_search_state;
   my $re_hyp = $re_ss->current_hypothesis;
diff --git a/lib/DX/Step/ConsiderProposition.pm b/lib/DX/Step/ConsiderProposition.pm
index 59d55ab..0b60a82 100644
--- a/lib/DX/Step/ConsiderProposition.pm
+++ b/lib/DX/Step/ConsiderProposition.pm
@@ -9,6 +9,12 @@ has proposition => (is => 'ro', isa => Proposition, required => 1);
 sub apply_to {
   my ($self, $ss) = @_;
   my $hyp = $ss->current_hypothesis;
+  trace consider => [
+    statement => [
+      [ symbol => 'consider' ],
+      @{$self->proposition->for_deparse->[1]},
+    ],
+  ];
   if (my $step = $self->proposition->resolve_for($hyp->scope)) {
     return $ss->but(next_step => $step);
   }
diff --git a/lib/DX/Step/EnterRecheck.pm b/lib/DX/Step/EnterRecheck.pm
index 2b17453..a1954a1 100644
--- a/lib/DX/Step/EnterRecheck.pm
+++ b/lib/DX/Step/EnterRecheck.pm
@@ -20,6 +20,11 @@ sub apply_to {
 
   my ($prop, @rest) = @{$self->proposition_list};
 
+  trace recheck => [ statement => [
+    [ symbol => 'recheck' ],
+    @{$prop->for_deparse->[1]},
+  ] ];
+
   my $old_hyp = $old_ss->current_hypothesis;
 
   # we should probably be doing something about pruning the scope
diff --git a/lib/DX/Step/FailRecheck.pm b/lib/DX/Step/FailRecheck.pm
index fb3b0bc..f303d78 100644
--- a/lib/DX/Step/FailRecheck.pm
+++ b/lib/DX/Step/FailRecheck.pm
@@ -8,6 +8,7 @@ has resume_search_state => (is => 'ro', isa => SearchState, required => 1);
 
 sub apply_to {
   my ($self, $old_ss) = @_;
+  trace recheck => [ statement => [ [ symbol => 'fail_recheck' ] ] ];
   return $self->resume_search_state;
 }
 
diff --git a/lib/DX/Step/ResolveProposition.pm b/lib/DX/Step/ResolveProposition.pm
index 07a0d5c..f2d2f27 100644
--- a/lib/DX/Step/ResolveProposition.pm
+++ b/lib/DX/Step/ResolveProposition.pm
@@ -59,6 +59,21 @@ sub but_with_dependencies_on {
 
 sub apply_to {
   my ($self, $old_ss) = @_;
+  trace resolve => [ statement => [
+    [ symbol => 'resolve' ],
+    [ block => [
+      [ statement => [
+        [ symbol => 'proposition' ],
+        @{$self->resolves->for_deparse->[1]},
+      ] ],
+      (@{$self->actions}
+        ? [ statement => [
+            [ symbol => 'actions' ],
+            [ block => [ @{$self->actions} ] ],
+          ] ]
+        : ()),
+    ] ]
+  ] ];
   my $ns = do {
     if (my $prop = $old_ss->next_proposition) {
       DX::Step::ConsiderProposition->new(