ADDED: dict_same_keys/2

Similar to same_functor/2.   This is a building block for a future
mapdict/3 predicate.

man/extensions.doc

@@ -1124,6 +1124,17 @@ is a duplicate key.
 Bi-directional mapping between a dict and an ordered list of pairs
 (see \secref{pairs}).
 
+    \predicate{dict_same_keys}{2}{?Dict1, ?Dict2}
+True when \arg{Dict1} and \arg{Dict2} have the same set of keys.  The
+\jargon{tag} is not considered.  This predicate is semidet if both
+arguments are instantiated to a dict.  If one is instantiated to a
+dict and the other is unbound, it generates a dict with the same
+keys and unbound tag and values.  The predicate is_dict/2 may be
+used test tag equivalence or unify the tags.   This predicate
+raises an \const{instantiation_error} if both argument are unbound
+or a \const{type_error} if one of the arguments is neither a dict
+nor a variable.
+
     \predicate{put_dict}{3}{+New, +DictIn, -DictOut}
 \arg{DictOut} is a new dict created by replacing or adding key-value pairs
 from \arg{New} to \arg{Dict}. \arg{New} is either a dict or a valid input

man/summary.doc

@@ -418,6 +418,7 @@ suggest predicates from a keyword.
 \predicatesummary{map_assoc}{3}{Map association tree}
 \predicatesummary{dict_create}{3}{Create a dict from data}
 \predicatesummary{dict_pairs}{3}{Convert between dict and list of pairs}
+\predicatesummary{dict_same_keys}{2}{True when dicts have the same keys}
 \predicatesummary{max_assoc}{3}{Highest key in association tree}
 \predicatesummary{memberchk}{2}{Deterministic member/2}
 \predicatesummary{message_hook}{3}{Intercept print_message/2}

src/Tests/core/test_dict.pl

@@ -3,7 +3,8 @@
     Author:        Jan Wielemaker
     E-mail:        [email protected]
     WWW:           http://www.swi-prolog.org
-    Copyright (c)  2013-2020, VU University Amsterdam
+    Copyright (c)  2013-2024, VU University Amsterdam
+			      SWI-Prolog Solutions b.v.
     All rights reserved.
 
     Redistribution and use in source and binary forms, with or without
@@ -264,6 +265,18 @@
 	a{x:_} :< a{y:2}.
 test(select, R =@= _{z:3}) :-		% implicit conversion
 	select_dict([x(1)], [x(1),z(3)], R).
+test(same_keys, true) :-
+	dict_same_keys(#{a:1, b:2}, ${a:x, b:3}).
+test(same_keys, fail) :-
+	dict_same_keys(#{a:1, b:2}, ${a:x, b:3, c:_}).
+test(same_keys, Copy =@= _{a:_, b:_}) :-
+	dict_same_keys(#{a:1, b:2}, Copy).
+test(same_keys, Copy =@= _{a:_, b:_}) :-
+	dict_same_keys(Copy, #{a:1, b:2}).
+test(same_keys, error(instantiation_error)) :-
+	dict_same_keys(_A1, _A2).
+test(same_keys, error(type_error(dict, aap))) :-
+	dict_same_keys(aap, _{a:1, b:2}).
 
 gd5 :-
 	Dict = #{a:42},

src/pl-dict.c

@@ -3,7 +3,7 @@
     Author:        Jan Wielemaker
     E-mail:        [email protected]
     WWW:           http://www.swi-prolog.org
-    Copyright (c)  2013-2022, VU University Amsterdam
+    Copyright (c)  2013-2024, VU University Amsterdam
 			      SWI-Prolog Solutions b.v.
     All rights reserved.
 
@@ -86,6 +86,28 @@ dict_functor(int pairs)
   }
 }
 
+static bool
+is_dict_functor(functor_t f)
+{ FunctorDef fd = valueFunctor(f);
+
+  return ( fd->name == ATOM_dict &&
+	   fd->arity%2 == 1 );
+}
+
+#define is_dict_term(w) \
+	LDFUNC(is_dict_term, w)
+
+static bool
+is_dict_term(DECL_LD word w)
+{ if ( isTerm(w) )
+  { Functor f = valueTerm(w);
+
+    return is_dict_functor(f->definition);
+  }
+
+  return false;
+}
+
 		 /*******************************
 		 *      LOW-LEVEL FUNCTIONS	*
 		 *******************************/
@@ -98,10 +120,8 @@ get_dict_ex(DECL_LD term_t t, Word dp, int ex)
   deRef(p);
   if ( isTerm(*p) )
   { Functor f = valueTerm(*p);
-    FunctorDef fd = valueFunctor(f->definition);
 
-    if ( fd->name == ATOM_dict &&
-	 fd->arity%2 == 1 )		/* does *not* validate ordering */
+    if ( is_dict_functor(f->definition) )
     { *dp = *p;
       return true;
     }
@@ -129,10 +149,8 @@ get_create_dict_ex(DECL_LD term_t t, term_t dt)
   deRef(p);
   if ( isTerm(*p) )
   { Functor f = valueTerm(*p);
-    FunctorDef fd = valueFunctor(f->definition);
 
-    if ( fd->name == ATOM_dict &&
-	 fd->arity%2 == 1 )		/* does *not* validate ordering */
+    if ( is_dict_functor(f->definition) )
     { *valTermRef(dt) = *p;
       return true;
     }
@@ -421,6 +439,69 @@ put_dict(DECL_LD word dict, int size, Word nv, word *new_dict)
 }
 
 
+#define copy_keys_dict(dict, new_dict) \
+	LDFUNC(copy_keys_dict, dict, new_dict)
+
+static int
+copy_keys_dict(DECL_LD word dict, word *new_dict)
+{ Functor data = valueTerm(dict);
+  size_t arity = arityFunctor(data->definition);
+  Word new, out, in, in_end;
+
+  if ( gTop+1 > gMax )
+    return GLOBAL_OVERFLOW;
+
+  new    = gTop;
+  out    = new;
+  *out++ = data->definition;
+  setVar(*out++);
+  in     = data->arguments+1;
+  in_end = in+arity-1;
+
+  while(in < in_end)
+  { Word i_name;
+
+    deRef2(in+1, i_name);
+    setVar(*out++);
+    *out++ = *i_name;
+    in += 2;
+  }
+
+  gTop = out;
+  *new_dict = consPtr(new, TAG_COMPOUND|STG_GLOBAL);
+
+  return true;
+}
+
+#define same_keys_dict(dict1, dict2) \
+	LDFUNC(same_keys_dict, dict1, dict2)
+
+static bool
+same_keys_dict(DECL_LD word dict1, word dict2)
+{ Functor data1 = valueTerm(dict1);
+  Functor data2 = valueTerm(dict2);
+  size_t arity = arityFunctor(data1->definition);
+
+  if ( data1->definition != data2->definition )
+    return false;
+
+  Word d1 = data1->arguments+1;
+  Word d2 = data2->arguments+1;
+  Word dend = d1+arity-1;
+
+  for(; d1 < dend; d1+=2, d2+=2)
+  { Word k1, k2;
+
+    deRef2(d1+1, k1);
+    deRef2(d2+1, k2);
+    if ( *k1 != *k2 )
+      return false;
+  }
+
+  return true;
+}
+
+
 #define del_dict(dict, key, new_dict) LDFUNC(del_dict, dict, key, new_dict)
 static int
 del_dict(DECL_LD word dict, word key, word *new_dict)
@@ -1118,7 +1199,7 @@ resort_dicts_in_term(DECL_LD Word p)
     Word ea;
     word dupl;
 
-    if ( fd->name == ATOM_dict && fd->arity%2 == 1 &&
+    if ( fd->name == ATOM_dict && fd->arity > 1 && fd->arity%2 == 1 &&
 	 dict_ordered(&t->arguments[1], fd->arity/2, &dupl) == false )
     { DEBUG(MSG_DICT, Sdprintf("Re-ordering dict\n"));
       dict_order((Word)t, &dupl);
@@ -1161,18 +1242,7 @@ PRED_IMPL("is_dict", 1, is_dict, 0)
   Word p = valTermRef(A1);
 
   deRef(p);
-  if ( isTerm(*p) )
-  { Functor f = valueTerm(*p);
-    FunctorDef fd = valueFunctor(f->definition);
-    //word dupl;
-
-    if ( fd->name == ATOM_dict &&
-	 fd->arity%2 == 1 /*&&
-	 dict_ordered(f->arguments+1, fd->arity/2, &dupl) == true*/ )
-      return true;
-  }
-
-  return false;
+  return is_dict_term(*p);
 }
 
 
@@ -1184,12 +1254,8 @@ PRED_IMPL("is_dict", 2, is_dict, 0)
   deRef(p);
   if ( isTerm(*p) )
   { Functor f = valueTerm(*p);
-    FunctorDef fd = valueFunctor(f->definition);
-    //word dupl;
 
-    if ( fd->name == ATOM_dict &&
-	 fd->arity%2 == 1 /*&&
-	 dict_ordered(f->arguments+1, fd->arity/2,  &dupl) == true*/ )
+    if ( is_dict_functor(f->definition) )
       return unify_ptrs(&f->arguments[0], valTermRef(A2),
 			ALLOW_GC|ALLOW_SHIFT);
   }
@@ -1415,6 +1481,60 @@ PRED_IMPL("dict_pairs", 3, dict_pairs, 0)
   return false;
 }
 
+/** dict_same_keys(?Dict1, ?Dict2) is semidet.
+*/
+
+#define unify_dict_copy(t, dt, dict)		\
+	LDFUNC(unify_dict_copy, t, dt, dict)
+
+static bool
+unify_dict_copy(DECL_LD term_t t, term_t dt, word dict)
+{ term_t tmp = PL_new_term_ref(); /* safe, we can allocate 10 */
+  word copy;
+  int rc;
+
+  for(;;)
+  { if ( (rc=copy_keys_dict(dict, &copy)) == true )
+    { *valTermRef(tmp) = copy;
+      return PL_unify(tmp, t);
+    }
+
+    if ( !makeMoreStackSpace(rc, ALLOW_SHIFT|ALLOW_GC) )
+      return false;
+
+    Word p = valTermRef(dt);
+    deRef(p);
+    dict = *p;
+  }
+}
+
+static
+PRED_IMPL("dict_same_keys", 2, dict_same_keys, 0)
+{ PRED_LD
+  Word d1 = valTermRef(A1);
+  Word d2 = valTermRef(A2);
+
+  deRef(d1);
+  deRef(d2);
+
+  if ( is_dict_term(*d1) )
+  { if ( is_dict_term(*d2) )
+      return same_keys_dict(*d1, *d2);
+    else if ( canBind(*d2) )
+      return unify_dict_copy(A2, A1, *d1);
+    else
+      return PL_type_error("dict", A2);
+  } else if ( is_dict_term(*d2) )
+  { if ( canBind(*d1) )
+      return unify_dict_copy(A1, A2, *d2);
+    else
+      return PL_type_error("dict", A1);
+  }
+
+  return PL_type_error("dict", A1);
+}
+
+
 
 /** put_dict(+New, +DictIn, -DictOut)
 
@@ -1747,20 +1867,21 @@ PL_get_dict_key(atom_t key, term_t dict, term_t value)
 		 *******************************/
 
 BeginPredDefs(dict)
-  PRED_DEF("is_dict",	   1, is_dict,	    0)
-  PRED_DEF("is_dict",	   2, is_dict,	    0)
-  PRED_DEF("dict_create",  3, dict_create,  0)
-  PRED_DEF("dict_pairs",   3, dict_pairs,   0)
-  PRED_DEF("put_dict",	   3, put_dict,	    0)
-  PRED_DEF("put_dict",	   4, put_dict,	    0)
-  PRED_DEF("b_set_dict",   3, b_set_dict,   0)
-  PRED_DEF("nb_set_dict",  3, nb_set_dict,  0)
-  PRED_DEF("nb_link_dict", 3, nb_link_dict, 0)
-  PRED_DEF("get_dict",	   3, get_dict,	    PL_FA_NONDETERMINISTIC)
-  PRED_DEF("$get_dict_ex", 3, get_dict_ex,  PL_FA_NONDETERMINISTIC)
-  PRED_DEF("del_dict",	   4, del_dict,	    0)
-  PRED_DEF("get_dict",     5, get_dict,     0)
-  PRED_DEF("select_dict",  3, select_dict,  0)
-  PRED_DEF(":<",	   2, select_dict,  0)
-  PRED_DEF(">:<",	   2, punify_dict,  0)
+  PRED_DEF("is_dict",	     1, is_dict,	0)
+  PRED_DEF("is_dict",	     2, is_dict,	0)
+  PRED_DEF("dict_create",    3, dict_create,    0)
+  PRED_DEF("dict_pairs",     3, dict_pairs,     0)
+  PRED_DEF("dict_same_keys", 2, dict_same_keys, 0)
+  PRED_DEF("put_dict",	     3, put_dict,       0)
+  PRED_DEF("put_dict",	     4, put_dict,       0)
+  PRED_DEF("b_set_dict",     3, b_set_dict,     0)
+  PRED_DEF("nb_set_dict",    3, nb_set_dict,    0)
+  PRED_DEF("nb_link_dict",   3, nb_link_dict,   0)
+  PRED_DEF("get_dict",	     3, get_dict,	PL_FA_NONDETERMINISTIC)
+  PRED_DEF("$get_dict_ex",   3, get_dict_ex,    PL_FA_NONDETERMINISTIC)
+  PRED_DEF("del_dict",	     4, del_dict,	0)
+  PRED_DEF("get_dict",       5, get_dict,       0)
+  PRED_DEF("select_dict",    3, select_dict,    0)
+  PRED_DEF(":<",	     2, select_dict,    0)
+  PRED_DEF(">:<",	     2, punify_dict,    0)
 EndPredDefs