rename is_dict to dict, add proto argument
Matt S Trout [Sat, 12 Mar 2016 06:14:55 +0000 (06:14 +0000)]
bin/dx
fragments/bind
lib/DX/Predicate/Dict.pm [moved from lib/DX/Predicate/IsDict.pm with 60% similarity]

diff --git a/bin/dx b/bin/dx
index 8abbd9c..cf0410e 100644 (file)
--- a/bin/dx
+++ b/bin/dx
@@ -20,7 +20,7 @@ use_module('DX::ShellFrontend')->new(
           predicates => {
           'eq' => use_module('DX::Predicate::Eq')->new,
           member_at => use_module('DX::Predicate::MemberAt')->new,
-          is_dict => use_module('DX::Predicate::IsDict')->new,
+          dict => use_module('DX::Predicate::Dict')->new,
         },
         globals => dict(),
         proposition_sequence
index d3d9d24..88f77c5 100644 (file)
@@ -1,5 +1,5 @@
 ?
-is_dict ?X
+dict ?X
 eq ?Y X
 qact
 eq Y {{ foo 1 }}
similarity index 60%
rename from lib/DX/Predicate/IsDict.pm
rename to lib/DX/Predicate/Dict.pm
index ce2278d..4a5628a 100644 (file)
@@ -1,4 +1,4 @@
-package DX::Predicate::IsDict;
+package DX::Predicate::Dict;
 
 use DX::Utils qw(step dict TYPE_OF);
 use DX::Class;
@@ -6,16 +6,19 @@ use DX::Class;
 with 'DX::Role::Predicate';
 
 sub _possible_resolution_list {
-  my ($self, $arg) = @_;
+  my ($self, $arg, $proto) = @_;
   if ($arg->is_set) {
-    die "is_dict called with non-dict"
+    die "dict called with non-dict"
       unless $arg->isa('DX::Value::Dict');
     return step(
       actions => [],
       depends_on => [ [ undef ,=> [ TYPE_OF ,=> $arg ] ] ]
     );
   }
-  my $set = $arg->action_for_set_value(dict());
+  if ($proto and not $proto->isa('DX::Value::Dict')) {
+    die "dict called with non-dict prototype";
+  }
+  my $set = $arg->action_for_set_value($proto||dict());
   return step(
     actions => [ $set ],
     depends_on => [ [ undef ,=> [ TYPE_OF ,=> $arg ] ] ]