X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDX%2FUtils.pm;h=4c9f0b879f9d94a89117310e55a3b9ba998db6a1;hb=c25fbf056abf91b25ef365e9be2a84eb2b132dba;hp=ce166e3afc19cbe8b72535250d47a75568e5d760;hpb=9d759b646ac5953926ce9414388c1691b8a4278b;p=scpubgit%2FDX.git diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm index ce166e3..4c9f0b8 100644 --- 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;