show dependencies before backtracking

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

package DX::Utils;

use strictures 2;
use Exporter 'import';

my @const = (
  my @dep_types = qw(EXISTENCE_OF TYPE_OF INDICES_OF CONTENTS_OF),
  my @ev_types = qw(VALUE_SET VALUE_EXISTS),
);

our @EXPORT_OK = (
  @const,
  (my @builders = qw(rspace rstrat res string number dict proposition)),
  'deparse', '*trace', 'expand_deps', 'format_deps',
);

our %EXPORT_TAGS = (
  all => \@EXPORT_OK,
  dep_types => \@dep_types,
  event_types => \@ev_types,
  builders => \@builders,
);

require constant;

# use constant INDICES_OF => \*INDICES_OF;

constant->import(+{
  map {; no strict 'refs'; $_ => \*$_ } @const
});

# $EXISTENCE_OF = 1, ...

do { no strict 'refs'; ${$dep_types[$_-1]} = $_ } for 1..@dep_types;

# VALUE_EXISTS needs to trigger indices checks on its parent

our $VALUE_EXISTS = 1;

# VALUE_EXISTS triggers all types, VALUE_SET all but EXISTENCE_OF

our @VALUE_EXISTS = (EXISTENCE_OF(), TYPE_OF(), INDICES_OF(), CONTENTS_OF());
our @VALUE_SET = (TYPE_OF(), INDICES_OF(), CONTENTS_OF());

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 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,
  );
}

{
  my $dp;

  sub deparse {
    $dp ||= do {
      require DX::TraceFormatter;
      DX::TraceFormatter->new;
    };
    my ($thing) = @_;
    $dp->format($thing);
  }
}

1;