sma backtracking (smart will be later ;)

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

diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm
index 0cb207d..74ff1e7 100644 (file)
--- a/lib/DX/Utils.pm
+++ b/lib/DX/Utils.pm
@@ -1,17 +1,18 @@
 package DX::Utils;
 
 use strictures 2;
+use List::UtilsBy qw(sort_by);
 use Exporter 'import';
 
 my @const = (
-  my @dep_types = qw(EXISTENCE_OF TYPE_OF INDICES_OF CONTENTS_OF),
+  my @dep_types = qw(CONTENTS_OF INDICES_OF TYPE_OF EXISTENCE_OF),
   my @ev_types = qw(VALUE_SET VALUE_EXISTS),
 );
 
 our @EXPORT_OK = (
   @const,
-  (my @builders = qw(step string number dict proposition)),
-  'deparse', '*trace',
+  (my @builders = qw(rspace rstrat res string number dict proposition)),
+  'deparse', '*trace', 'expand_deps', 'format_deps', 'compact_deps',
 );
 
 our %EXPORT_TAGS = (
@@ -29,7 +30,7 @@ constant->import(+{
   map {; no strict 'refs'; $_ => \*$_ } @const
 });
 
-# $EXISTENCE_OF = 1, ...
+# $CONTENTS_OF = 1, ... # stronger dependency has lower number
 
 do { no strict 'refs'; ${$dep_types[$_-1]} = $_ } for 1..@dep_types;
 
@@ -52,17 +53,61 @@ sub _expand_dep {
   return [ $type, @expanded ];
 }
 
-sub _expand_deps {
+sub expand_deps {
   [ map _expand_dep($_), @{$_[0]} ]
 }
 
-sub step {
-  require DX::Step::ResolveProposition;
-  my %args = @_;
-  DX::Step::ResolveProposition->new(
-    %args,
-    depends_on => _expand_deps($args{depends_on}),
-  );
+sub format_deps {
+  [ block => [
+      map [ statement => [
+        [ symbol => (split '::', ${$_->[0]})[-1] ],
+        [ value_path => [ @{$_}[1..$#$_] ] ]
+      ] ], @{$_[0]}
+  ] ]
+}
+
+sub compact_deps {
+  my ($deps) = @_;
+  my @sorted = sort_by { join "\0", @{$_->[0]} }
+                 map { [ [ join("\0", @{$_}[1..$#$_], ''), $${$_->[0]} ], $_ ] } @$deps;
+  my @compacted;
+  while (my $s = shift @sorted) {
+    my ($path, $type) = @{$s->[0]};
+    shift @sorted while @sorted and $sorted[0][0][0] eq $path;
+    if ($type == 1) { # CONTENTS_OF dep, prune children
+      my $len = length($path);
+      shift @sorted while @sorted and substr($sorted[0][0][0], 0, $len) eq $path;
+    }
+    if ($type == 2) { # INDICES_OF dep, drop immediately below EXISTENCE_OF
+      my $len = length($path);
+      my $parts = @{$s->[1]} + 1;
+      my @keep;
+      while (@sorted and substr($sorted[0][0][0], 0, $len) eq $path) {
+        my $check = shift @sorted;
+        unless ($check->[0][1] == 4 and @{$check->[1]} == $parts) {
+          push @keep, $check;
+        }
+      }
+      unshift @sorted, @keep;
+    }
+    push @compacted, $s->[1];
+  }
+  return \@compacted;
+}
+
+sub rspace {
+  require DX::ResolutionSpace;
+  DX::ResolutionSpace->new(@_);
+}
+
+sub rstrat {
+  require DX::ResolutionStrategy;
+  DX::ResolutionStrategy->new(@_);
+}
+
+sub res {
+  require DX::Resolution;
+  DX::Resolution->new(@_);
 }
 
 sub string {
@@ -96,11 +141,11 @@ sub proposition {
 
   sub deparse {
     $dp ||= do {
-      require DX::Deparse;
-      DX::Deparse->new;
+      require DX::TraceFormatter;
+      DX::TraceFormatter->new;
     };
     my ($thing) = @_;
-    $dp->fmt($thing);
+    $dp->format($thing);
   }
 }