add qdeps debug command

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

package DX::Utils;

use strictures 2;
use Exporter 'import';

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

our @EXPORT_OK = (
  @const,
  (my @builders = qw(step string number dict proposition)),
  'deparse', 'trace',
);

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

# $INDICES_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(), INDICES_OF(), TYPE_OF(), CONTENTS_OF());
our @VALUE_SET = (INDICES_OF(), TYPE_OF(), CONTENTS_OF());

sub trace {
  my ($tag, $thing) = @_;
  my $dp = deparse($thing);
  $dp =~ s/\n//;
  warn "${tag}: ${dp}\n";
}

sub step {
  require DX::Step::Normal;
  DX::Step::Normal->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::Deparse;
      DX::Deparse->new;
    };
    my ($thing) = @_;
    $dp->fmt($thing);
  }
}

1;