nerf member_at to prepare for decision dependency and aperture work

diff --git a/fragment.output/bind b/fragment.output/bind
index 6c97461..5e23bc0 100644 (file)
--- a/fragment.output/bind
+++ b/fragment.output/bind
@@ -27,7 +27,10 @@ BindValue 0.Z 0.Y.bar
 SetBoundValue 0.Z 2
 SetBoundValue 0.Y.bar 2
 SetValue 0.X.foo.bar 2
-? member_at Y 'baz' 4
+? member_at Y 'baz' ?U
+BindValue 0.U 0.Y.baz
+? eq U 4
+SetBoundValue 0.U 4
 AddBoundValue 0.Y.baz 4
 AddValue 0.X.foo.baz 4
 ? qact
@@ -36,5 +39,6 @@ SetValue 0.X.foo.bar 2
 BindValue 0.Z 0.Y.bar
 AddValue 0.X.foo.baz 4
 BindValue 0.Y 0.X.foo
+BindValue 0.U 0.Y.baz
 ? .
-{{ X {{ foo {{ bar 2 baz 4 }} }} Y {{ bar 2 baz 4 }} Z 2 }}
+{{ U 4 X {{ foo {{ bar 2 baz 4 }} }} Y {{ bar 2 baz 4 }} Z 2 }}

diff --git a/fragments/bind b/fragments/bind
index b0d886b..aa85303 100644 (file)
--- a/fragments/bind
+++ b/fragments/bind
@@ -11,6 +11,7 @@ dict ?X {{ foo {{ bar 1 }} }}
 member_at X 'foo' ?Y
 member_at Y 'bar' ?Z
 eq Z 2
-member_at Y 'baz' 4
+member_at Y 'baz' ?U
+eq U 4
 qact
 .

diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index bde4bf1..d999e77 100644 (file)
--- a/lib/DX/Predicate/MemberAt.pm
+++ b/lib/DX/Predicate/MemberAt.pm
@@ -11,80 +11,68 @@ sub _possible_resolution_list {
   my ($self, $coll, $key, $value) = @_;
   die "First argument to member_at must be a structured value"
     unless $coll->does('DX::Role::StructuredValue');
-  return (
-    ($key->is_set
-      ? map $_->but_with_dependencies_on(
-          [ undef ,=>
-            [ EXISTENCE_OF ,=> $coll, $key->string_value ],
-            [ CONTENTS_OF ,=> $key ],
-          ]
-        ), do {
-          if (my $cur_val = $coll->get_member_at($key)) {
-            $self->_make_equal($cur_val, $value);
-          } elsif (
-            $value->is_set
-            and my $add = $coll->action_for_add_member($key, $value)
-          ) {
-            step(
-              actions => [ $add ],
-              depends_on => [
-                [ $value =>
-                  [ CONTENTS_OF ,=> $coll, $key->string_value ],
-                  [ CONTENTS_OF ,=> $value ],
-                ],
-              ],
-            );
-          } elsif (
-            !$value->is_set
-            and $value->action_builder->isa('DX::ActionBuilder::UnsetValue')
-            and my $p = $coll->value_path
-          ) {
-            my @path = (@$p, $key->string_value);
-            my $ab = DX::ActionBuilder::ProxySetToAdd->new(
-              target_path => \@path,
-              proxy_to => $coll->action_builder,
-            );
-            my $set = $value->action_for_set_value(
-                        $value->but(
-                          action_builder => $ab
-                        )
-                      );
-            step(
-              actions => [ $set ],
-              depends_on => [
-                [ $value =>
-                  [ CONTENTS_OF ,=> $coll, $key->string_value ],
-                  [ CONTENTS_OF ,=> $value ],
-                ],
-              ],
-            );
-          } else {
-            ()
-          }
-        }
-      : ()
-    ),
-    (!$key->is_set
-     && $key->action_builder->isa('DX::ActionBuilder::UnsetValue')
-      ? map {
-          my $set_key = DX::Action::SetValue->new(
-            target_path => $key->action_builder->target_path,
-            new_value => DX::ActionBuilder::Null->new(
-                           target_path => $key->action_builder->target_path,
-                         )->apply_to_value(string(my $kstr = $_))
-          );
-          map $_->but_first($set_key)
-                ->but_with_dependencies_on(
-                    [ undef ,=>
-                      [ EXISTENCE_OF ,=> $coll, $kstr ],
-                      [ CONTENTS_OF ,=> $key ],
-                    ]
-                  ),
-            $self->_make_equal($coll->get_member_at($_), $value);
-        } $coll->index_list
-      : ()
-    ),
-  );
+  my $basic_deps = sub {
+    (depends_on => [
+      [ undef ,=>
+        [ EXISTENCE_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
+        [ CONTENTS_OF ,=> $_[0] ],
+      ],
+      [ $value ,=>
+        [ CONTENTS_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
+        [ CONTENTS_OF ,=> $value ],
+      ],
+    ])
+  };
+  if ($value->is_set) {
+    # Already set values are only supported for recheck
+    trace member_at => "+D +K +V";
+    return () unless $key->is_set and my $cur_val = $coll->get_member_at($key);
+    return () unless $cur_val->equals($value);
+    return step(
+      actions => [],
+      $basic_deps->($key),
+    );
+  }
+  die "Bizarre: member_at called with non-fresh unset value"
+    unless $value->action_builder->isa('DX::ActionBuilder::UnsetValue');
+  if ($key->is_set) { 
+    trace member_at => "+D +K -V";
+    if (my $cur_val = $coll->get_member_at($key)) {
+      my $set = $value->action_for_set_value($cur_val);
+      return step(
+        actions => [ $set ],
+        $basic_deps->($key),
+      );
+    }
+    if (my $p = $coll->value_path) {
+      my @path = (@$p, $key->string_value);
+      my $ab = DX::ActionBuilder::ProxySetToAdd->new(
+        target_path => \@path,
+        proxy_to => $coll->action_builder,
+      );
+      my $set = $value->action_for_set_value(
+                  $value->but(
+                    action_builder => $ab
+                  )
+                );
+      return step(
+        actions => [ $set ],
+        $basic_deps->($key),
+      );
+    }
+    return ();
+  }
+  die "Bizarre: member_at called with non-fresh unset key"
+    unless $key->action_builder->isa('DX::ActionBuilder::UnsetValue');
+  trace member_at => "+D -K -V";
+  return map {
+           my $set_key = $key->action_for_set_value(my $kstr = string($_));
+           my $set_value = $value->action_for_set_value($coll->get_member_at($kstr));
+           step(
+             actions => [ $set_key, $set_value ],
+             $basic_deps->($key, $kstr),
+           );
+         } $coll->index_list;
 }
 
 sub selection_depends_on {