rewrite deparse system

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

diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm
index ce166e3..4c9f0b8 100644 (file)
--- a/lib/DX/Utils.pm
+++ b/lib/DX/Utils.pm
@@ -3,28 +3,120 @@ package DX::Utils;
 use strictures 2;
 use Exporter 'import';
 
-our @EXPORT_OK = qw(INDICES INDEX_EXISTS ROOT_ONLY step string number);
+my @const = (
+  my @dep_types = qw(EXISTENCE_OF TYPE_OF INDICES_OF CONTENTS_OF),
+  my @ev_types = qw(VALUE_SET VALUE_EXISTS),
+);
 
-use constant INDICES => \*INDICES;
-use constant INDEX_EXISTS => \*INDEX_EXISTS;
-use constant ROOT_ONLY => \*ROOT_ONLY;
+our @EXPORT_OK = (
+  @const,
+  (my @builders = qw(step rspace rstrat res 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
+});
+
+# $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 step {
-  DX::Step::Normal->new(@_);
+  require DX::Step::ResolveProposition;
+  my %args = @_;
+  DX::Step::ResolveProposition->new(
+    %args,
+    depends_on => _expand_deps($args{depends_on}),
+  );
+}
+
+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]);
 }
 
-# Here so that circular require doesn't stab us in the face
+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;
 
-require DX::Step::Normal;
-require DX::Value::String;
-require DX::Value::Number;
+  sub deparse {
+    $dp ||= do {
+      require DX::Deparse;
+      DX::Deparse->new;
+    };
+    my ($thing) = @_;
+    $dp->format($thing);
+  }
+}
 
 1;