From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 12 Mar 2016 06:14:55 +0000 (+0000)
Subject: rename is_dict to dict, add proto argument
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9fd6087bd2bc47d259abd8571c693560d6f7124e;p=scpubgit%2FDX.git

rename is_dict to dict, add proto argument
---

diff --git a/bin/dx b/bin/dx
index 8abbd9c..cf0410e 100644
--- 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
diff --git a/fragments/bind b/fragments/bind
index d3d9d24..88f77c5 100644
--- a/fragments/bind
+++ b/fragments/bind
@@ -1,5 +1,5 @@
 ?
-is_dict ?X
+dict ?X
 eq ?Y X
 qact
 eq Y {{ foo 1 }}
diff --git a/lib/DX/Predicate/IsDict.pm b/lib/DX/Predicate/Dict.pm
similarity index 60%
rename from lib/DX/Predicate/IsDict.pm
rename to lib/DX/Predicate/Dict.pm
index ce2278d..4a5628a 100644
--- a/lib/DX/Predicate/IsDict.pm
+++ b/lib/DX/Predicate/Dict.pm
@@ -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 ] ] ]