package DX::Utils;
use strictures 2;
+use List::UtilsBy qw(sort_by);
use Exporter 'import';
my @const = (
- my @dep_types = qw(EXISTENCE_OF INDICES_OF TYPE_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',
+ (my @builders = qw(rspace rstrat res string number dict proposition)),
+ 'deparse', '*trace', 'expand_deps', 'format_deps', 'compact_deps',
);
our %EXPORT_TAGS = (
map {; no strict 'refs'; $_ => \*$_ } @const
});
-# $INDICES_OF = 1, ...
+# $CONTENTS_OF = 1, ... # stronger dependency has lower number
do { no strict 'refs'; ${$dep_types[$_-1]} = $_ } for 1..@dep_types;
# VALUE_EXISTS triggers all types, VALUE_SET all but EXISTENCE_OF
-our @VALUE_EXISTS = (EXISTENCE_OF(), INDICES_OF(), TYPE_OF(), CONTENTS_OF());
-our @VALUE_SET = (INDICES_OF(), TYPE_OF(), CONTENTS_OF());
+our @VALUE_EXISTS = (EXISTENCE_OF(), TYPE_OF(), INDICES_OF(), CONTENTS_OF());
+our @VALUE_SET = (TYPE_OF(), INDICES_OF(), CONTENTS_OF());
-sub step {
- DX::Step::Normal->new(@_);
+sub trace { }
+
+sub _expand_dep {
+ my ($type, @path) = @{$_[0]};
+ my @expanded = map {
+ ref() ? @{$_->value_path or return ()} : $_
+ } @path;
+ return [ $type, @expanded ];
+}
+
+sub expand_deps {
+ [ map _expand_dep($_), @{$_[0]} ]
+}
+
+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 {
+ require DX::Value::String;
DX::Value::String->new(string_value => $_[0])
}
sub number {
+ require DX::Value::Number;
DX::Value::Number->new(number_value => $_[0]);
}
sub dict {
+ require DX::Value::Dict;
DX::Value::Dict->new(
members => { @_ },
);
sub proposition {
my ($pred, @args) = @_;
+ require DX::Proposition;
DX::Proposition->new(
predicate => $pred,
args => \@args,
}
{
- require DX::Deparse;
- my $dp = DX::Deparse->new;
+ my $dp;
sub deparse {
+ $dp ||= do {
+ require DX::TraceFormatter;
+ DX::TraceFormatter->new;
+ };
my ($thing) = @_;
- $dp->fmt($thing);
+ $dp->format($thing);
}
}
-# Here so that circular require doesn't stab us in the face
-
-require DX::Step::Normal;
-require DX::Value::String;
-require DX::Value::Number;
-require DX::Value::Dict;
-require DX::Proposition;
-
1;