From: Matt S Trout Date: Sun, 23 Apr 2017 04:00:49 +0000 (+0000) Subject: first cut of rspace/rstrat code with eq semi cut over X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7f385fb233701e2f749cff0ab718774828e4d1d1;p=scpubgit%2FDX.git first cut of rspace/rstrat code with eq semi cut over --- diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm index a324524..4961c0d 100644 --- a/lib/DX/ActionBuilder/BoundValue.pm +++ b/lib/DX/ActionBuilder/BoundValue.pm @@ -14,6 +14,8 @@ has bound_to_path => (is => 'ro', required => 1); has inner_action_builder => (is => 'ro', required => 1); +sub can_set_value { shift->inner_action_builder->can_set_value } + sub action_for_set_value { my ($self, $value) = @_; my $inner_action = $self->inner_action_builder->action_for_set_value($value); diff --git a/lib/DX/Deparse.pm b/lib/DX/Deparse.pm index ce3f177..0b01d2b 100644 --- a/lib/DX/Deparse.pm +++ b/lib/DX/Deparse.pm @@ -30,6 +30,10 @@ sub _fmt { $self->${\"_fmt_${type}"}($thing, $meta); } +sub _fmt_error_typetiny_assertion { + $_[1]->to_string; +} + sub _fmt_value_dict { my ($self, $dict, $meta) = @_; my $chunks = $self->_fmt_pairs([ diff --git a/lib/DX/Predicate/Eq.pm b/lib/DX/Predicate/Eq.pm index b5db3a5..4f27475 100644 --- a/lib/DX/Predicate/Eq.pm +++ b/lib/DX/Predicate/Eq.pm @@ -1,45 +1,53 @@ package DX::Predicate::Eq; -use DX::Utils qw(step CONTENTS_OF); +use DX::Utils qw(step rspace res CONTENTS_OF); use DX::Class; with 'DX::Role::Predicate'; sub _possible_resolution_list { + my ($self, @args) = @_; + my $rspace = $self->_resolution_space_for(@args); + return () unless my @members = @{$rspace->members}; + return map step( + actions => $_->actions, + depends_on => $_->veracity_depends_on + ), @members; +} + +sub _resolution_space_for { my ($self, $left, $right) = @_; + + my $deps = [ [ CONTENTS_OF ,=> $left ], [ CONTENTS_OF ,=> $right ] ]; + if ($left->equals($right)) { - return step( - actions => [], - depends_on => [ - [ CONTENTS_OF ,=> $left ], [ CONTENTS_OF ,=> $right ] - ], + return rspace( + geometry_depends_on => $deps, + members => [ + res( + actions => [], + veracity_depends_on => $deps, + ) + ] ); } - return ( - do { - if ($left->is_set and my $set = $right->action_for_set_value($left)) { - step( - actions => [ $set ], - depends_on => [ - [ CONTENTS_OF ,=> $left ], [ CONTENTS_OF ,=> $right ] - ] - ) - } else { - () - } - }, - do { - if ($right->is_set and my $set = $left->action_for_set_value($right)) { - step( - actions => [ $set ], - depends_on => [ - [ CONTENTS_OF ,=> $left ], [ CONTENTS_OF ,=> $right ] - ] - ) - } else { - () - } - }, + + my @members = map { + my ($set_this, $to_this) = @$_; + res( + actions => [ $set_this->action_for_set_value($to_this) ], + veracity_depends_on => $deps, + ); + } grep { + $_->[0]->can_set_value + } ( + [ $left, $right ], + [ $right, $left ], + ); + + return rspace( + geometry_depends_on => $deps, + members => \@members, ); } diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm index e01f9d4..41c398f 100644 --- a/lib/DX/Predicate/MemberAt.pm +++ b/lib/DX/Predicate/MemberAt.pm @@ -1,6 +1,6 @@ package DX::Predicate::MemberAt; -use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF string); +use DX::Utils qw(:builders :dep_types); use DX::ActionBuilder::ProxySetToAdd; use DX::ActionBuilder::Null; use DX::Class; @@ -80,4 +80,188 @@ sub selection_depends_on { ] } +# member_at Dict Key Value +# +# Dict must be set to a dict (later maybe also an array and Key -> Index) +# +# Key bound -> +# +# Key exists -> +# +# Value bound -> +# +# Dict.Key = Value -> +# +# Trivial resolution +# +# Dict.Key != Value -> +# +# Failure +# +# Value unbound -> +# +# Set value to Dict.Key +# +# Key does not exist -> +# +# Dict allows add -> +# +# Value bound -> +# +# Failure on (exists Dict.Key, Value) +# +# Value unbound -> +# +# Set value to ProxySetToAdd value +# +# Dict disallows add -> +# +# Failure on (exists Dict.Key) +# +# Key unbound -> +# +# Value must also be unbound, because seriously? +# +# Set [Key, Value] to each pair in turn + +sub _resolution_space_for { + my ($self, $dict, $key, $value) = @_; + + die "Fucked" unless $dict->does('DX::Role::StructuredValue'); + + if ($key->is_set) { + + if (my $cur_val = $dict->get_member_at($key)) { + + my $deps = [ + [ CONTENTS_OF ,=> $dict, $key->string_value ], + [ CONTENTS_OF ,=> $value ], + ]; + + if ($value->is_set) { + + my @members = ( + $cur_val->equals($value) + # Trivial resolution, D.K = V + ? res( + actions => [], + veracity_depends_on => $deps, + ) + # Failure + : () + ); + + return rspace( + geometry_depends_on => $deps, + members => \@members + ); + + } + + return rspace( + geometry_depends_on => [ + [ CONTENTS_OF ,=> $dict, $key->string_value ], + [ TYPE_OF ,=> $value ], + ], + members => [ + res( + actions => [ $value->action_for_set_value($cur_val) ], + veracity_depends_on => $deps, + ), + ] + ); + + } + + if ($dict->can_add_member) { + + my $deps = [ + [ EXISTENCE_OF ,=> $dict, $key->string_value ], + [ TYPE_OF ,=> $value ], + ]; + + if ($value->is_set) { + + # If we get here, it means (currently) that we entered recheck + # due to the deletion of the key from the dict and should fail + # (or there's a bug in the compiler but let's hope not) + return rspace( + geometry_depends_on => $deps, + members => [], + ); + } + + my @path = (@{$dict->value_path}, $key->string_value); + my $ab = DX::ActionBuilder::ProxySetToAdd->new( + target_path => \@path, + proxy_to => $dict->action_builder, + ); + + return rspace( + geometry_depends_on => $deps, + members => [ + res( + actions => [ + $value->action_for_set_value( + $value->but(action_builder => $ab), + ), + ], + # Veracity only depends on EXISTENCE_OF at this stage - if the + # $value is later set, recheck will lead us down a different path + # that will update those dependencies to include CONTENTS_OF + veracity_depends_on => $deps, + ), + ], + ); + + } + + # Dict doesn't allow adding keys and key doesn't exist, so + # the contents of the value is completely irrelevant to the failure + return rspace( + geometry_depends_on => [ + [ EXISTENCE_OF ,=> $dict, $key->string_value ], + ], + members => [], + ); + + } + + die "Fucked" if $value->is_set; # +D -K +V ? seriously ? + + # Laaater we may need to look at autovivifying an additional key/index + # ala ProxySetToAdd but I'm not 100% sure how that will make sense and + # premature generalisation is the root of all eval. + + my @cand = map [ + [ $_ ], + [ $dict->get_member_at($_) ], + ], map string($_), $dict->index_list; + + return rspace( + geometry_depends_on => [ + [ INDICES_OF ,=> $dict ], + [ TYPE_OF ,=> $key ], + [ TYPE_OF ,=> $value ], + ], + members => [ + rstrat( + action_prototypes => [ + [ $key => 'set_value' ], + [ $value => 'set_value' ], + ], + veracity_depends_on_builder => sub { + my ($this_key, $this_val) = @_; + return [ + [ CONTENTS_OF ,=> $dict, $this_key->string_value ], + [ CONTENTS_OF ,=> $key ], + [ CONTENTS_OF ,=> $value ], + ]; + }, + implementation_candidates => \@cand, + ), + ], + ); +} + 1; diff --git a/lib/DX/Resolution.pm b/lib/DX/Resolution.pm index f786f39..1d5d335 100644 --- a/lib/DX/Resolution.pm +++ b/lib/DX/Resolution.pm @@ -2,17 +2,8 @@ package DX::Resolution; use DX::Class; -has proposition => (is => 'ro', required => 1); +has veracity_depends_on => (is => 'ro', required => 1); -has dependencies => (is => 'ro', required => 1); - -has scope_depth => (is => 'ro', required => 1); - -sub but_recheck_against { - my ($self, $hyp) = @_; - my $scope_hyp = $hyp->but( - scope => $hyp->scope->prune_to($self->scope_depth) - ); -} +has actions => (is => 'ro', required => 1); 1; diff --git a/lib/DX/ResolutionSpace.pm b/lib/DX/ResolutionSpace.pm new file mode 100644 index 0000000..abb83ea --- /dev/null +++ b/lib/DX/ResolutionSpace.pm @@ -0,0 +1,9 @@ +package DX::ResolutionSpace; + +use DX::Class; + +has geometry_depends_on => (is => 'ro', required => 1); + +has members => (is => 'ro', required => 1); + +1; diff --git a/lib/DX/ResolutionStrategy.pm b/lib/DX/ResolutionStrategy.pm new file mode 100644 index 0000000..ca3f23a --- /dev/null +++ b/lib/DX/ResolutionStrategy.pm @@ -0,0 +1,20 @@ +package DX::ResolutionStrategy; + +use DX::Class; + +has action_prototypes => (is => 'ro', required => 1); + +has veracity_depends_on_builder => (is => 'ro', required => 1); + +has implementation_candidates => (is => 'ro', required => 1); + +has aperture => (is => 'lazy', builder => sub { + my ($self) = @_; + return [ + # [ $thing, 'set_value' ] -> $thing->aperture_for_set_value + map @{$_->[0]->${\'aperture_for_'.$_[1]}()}, + @{$self->action_prototypes} + ]; +}); + +1; diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm index 0cb207d..37a0829 100644 --- a/lib/DX/Utils.pm +++ b/lib/DX/Utils.pm @@ -10,7 +10,7 @@ my @const = ( our @EXPORT_OK = ( @const, - (my @builders = qw(step string number dict proposition)), + (my @builders = qw(step rspace rstrat res string number dict proposition)), 'deparse', '*trace', ); @@ -65,6 +65,21 @@ sub step { ); } +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])