hash: support both semantics of weak keys + values.

Hash tables with weak keys and values now support a choice of both
possible semantics: under and-semantics, an entry lapses when both the
key and value are unreachable. Under or-semantics, an entry lapses if
either the key or value is unreachable.

The and-semantics is new. Until TXR 266, only or-semantics was
supported. This will be the default: when a hash table is specified
as :weak-keys and :weak-vals, it will have or-semantics.

The keywords :weak-or and :weak-and specify weak keys and values,
with the specific semantics. They are utually exclusive, but tolerate
the presence of :weak-keys and :weak-vals.

The make-hash function is being extended such that if its leftmost
argument, <weak-keys>, is specified as one of the keywords :weak-and
or :weak-or, then the hash table will have weak keys and values with the
specified semantics, and the <weak-vals> argument is ignored
(values are weak even if that argument is false).

* eval.c (eval_init): Initially register the top_vb,
top_mb, top_smb, special and builtin hashes as ordinary hashes: no weak
keys or values. Then use tweak_hash to switch to weak keys+vals
with and-semantics. We do it this way because the keywords are not yet
initialized; we cannot use them.

* hash.h (enum hash_flags, hash_flags_t): Moved to header. Member
hash_weak_both renamed to hash_weak_or. New member hash_weak_and.
(weak_and_k, weak_or_k): New keyword variables.
(hash_print_op): Handle hash_weak_and by printing :weak-and.
(hash_mark): Handle hash_weak_and by marking nothing, like hash_weak_or.
(do_make_hash): Check first argument against the two new keywords and
set flags accordingly. This function is called from eval_init before
the keywords have been initialized, in which case weak_keys ==
weak_and_k is true when both are nil; we watch for that.
(tweak_hash): Now returns void and takes a hash_flags_t argument which
is simply planted.
(do_wak_tables): Implement hash_weak_and case. Remove the compat 266
stuff from hash_weak_or. Compatibility is no longer required since we
are not changing the default semantics of hash tables. Phew; that's a
load of worry off the plate.
(hashv): Parse the two new keywords, validate and provide semantics.
(hash_init): Initialize weak_and_k and weak_or_k kewyords.

* hash.h (enum hash_flags, hash_flags_t): Moved here now.
(weak_and_k, weak_or_k): Declared.

* lib.c (compat_fixup): Remove call to parse_compat_fixup.

* parser.c (parse_init): Create stream_parser_hash with and-semantics.
(parse_compat_fixup): Function removed.

* parser.h (parse_compat_fixup): Declaration removed.

* txr.1: Hash documentation updated.

7 files changed, 171 insertions, 99 deletions

diff --git a/eval.c b/eval.c
index 77db6610..bb96d0cf 100644
--- a/eval.c
+++ b/eval.c
@@ -6488,15 +6488,22 @@ void eval_init(void)
           &call_f, &iter_begin_f, &iter_from_binding_f, &iter_more_f,
           &iter_item_f, &iter_step_f,
           &unbound_s, &origin_hash, &const_foldable_hash, convert(val *, 0));
-  top_fb = make_hash(t, t, nil);
-  top_vb = make_hash(t, t, nil);
-  top_mb = make_hash(t, t, nil);
-  top_smb = make_hash(t, t, nil);
-  special = make_hash(t, t, nil);
-  builtin = make_hash(t, t, nil);
+  top_fb = make_hash(nil, nil, nil);
+  top_vb = make_hash(nil, nil, nil);
+  top_mb = make_hash(nil, nil, nil);
+  top_smb = make_hash(nil, nil, nil);
+  special = make_hash(nil, nil, nil);
+  builtin = make_hash(nil, nil, nil);
   op_table = make_hash(nil, nil, nil);
   pm_table = make_hash(nil, nil, nil);
 
+  tweak_hash(top_fb, hash_weak_and);
+  tweak_hash(top_vb, hash_weak_and);
+  tweak_hash(top_mb, hash_weak_and);
+  tweak_hash(top_smb, hash_weak_and);
+  tweak_hash(special, hash_weak_and);
+  tweak_hash(builtin, hash_weak_and);
+
   call_f = func_n1v(generic_funcall);
   iter_begin_f = func_n1(iter_begin);
   iter_from_binding_f = chain(cdr_f, iter_begin_f, nao);
@@ -7325,15 +7332,6 @@ void eval_init(void)
 
 void eval_compat_fixup(int compat_ver)
 {
-  if (compat_ver <= 266) {
-    tweak_hash(top_fb, t, nil);
-    tweak_hash(top_vb, t, nil);
-    tweak_hash(top_mb, t, nil);
-    tweak_hash(top_smb, t, nil);
-    tweak_hash(special, t, nil);
-    tweak_hash(builtin, t, nil);
-  }
-
   if (compat_ver <= 257)
     reg_fun(intern(lit("lexical-var-p"), user_package),
             func_n2(old_lexical_var_p));
diff --git a/hash.c b/hash.c
index 6caa7397..280d47ea 100644
--- a/hash.c
+++ b/hash.c
@@ -50,13 +50,6 @@
 #include "time.h"
 #include "hash.h"
 
-typedef enum hash_flags {
-  hash_weak_none = 0,
-  hash_weak_keys = 1,
-  hash_weak_vals = 2,
-  hash_weak_both = 3
-} hash_flags_t;
-
 typedef enum hash_type {
   hash_type_eq,
   hash_type_eql,
@@ -91,7 +84,7 @@ static_forward(struct hash_ops hash_eq_ops);
 static_forward(struct hash_ops hash_eql_ops);
 static_forward(struct hash_ops hash_equal_ops);
 
-val weak_keys_k, weak_vals_k, userdata_k;
+val weak_keys_k, weak_vals_k, weak_and_k, weak_or_k, userdata_k;
 val equal_based_k, eql_based_k, eq_based_k;
 val hash_seed_s;
 
@@ -534,7 +527,7 @@ static void hash_print_op(val hash, val out, val pretty, struct strm_ctx *ctx)
       put_char(chr(' '), out);
     need_space = 1;
     switch (h->flags) {
-    case hash_weak_both:
+    case hash_weak_or:
       obj_print_impl(weak_keys_k, out, pretty, ctx);
       put_char(chr(' '), out);
       /* fallthrough */
@@ -544,6 +537,9 @@ static void hash_print_op(val hash, val out, val pretty, struct strm_ctx *ctx)
     case hash_weak_keys:
       obj_print_impl(weak_keys_k, out, pretty, ctx);
       break;
+    case hash_weak_and:
+      obj_print_impl(weak_and_k, out, pretty, ctx);
+      break;
     default:
       break;
     }
@@ -634,7 +630,8 @@ static void hash_mark(val hash)
       }
     }
     break;
-  case hash_weak_both:
+  case hash_weak_or:
+  case hash_weak_and:
     /* mark nothing */
     break;
   }
@@ -809,6 +806,13 @@ static val do_make_hash(val weak_keys, val weak_vals,
 
     h->usecount = 0;
 
+    if (weak_keys) {
+      if (weak_keys == weak_and_k)
+        h->flags = hash_weak_and;
+      else if (weak_keys == weak_or_k)
+        h->flags = hash_weak_or;
+    }
+
     switch (type) {
     case hash_type_eq:
       h->hops = &hash_eq_ops;
@@ -826,13 +830,11 @@ static val do_make_hash(val weak_keys, val weak_vals,
   }
 }
 
-val tweak_hash(val hash, val weak_keys, val weak_vals)
+void tweak_hash(val hash, hash_flags_t flags)
 {
-  val self = lit("tweak-hash");
+  val self = lit("internal-error");
   struct hash *h = coerce(struct hash *, cobj_handle(self, hash, hash_cls));
-  int flags = ((weak_vals != nil) << 1) | (weak_keys != nil);
-  h->flags = convert(hash_flags_t, flags);
-  return hash;
+  h->flags = flags;
 }
 
 val make_seeded_hash(val weak_keys, val weak_vals, val equal_based, val seed)
@@ -1280,51 +1282,50 @@ static void do_weak_tables(void)
         }
       }
       break;
-    case hash_weak_both:
+    case hash_weak_and:
       /* Sweep through all entries. Delete any which have keys
-         or values that are garbage. */
-      if (opt_compat && opt_compat <= 266) {
-        for (i = 0; i < h->modulus; i++) {
-          val *pchain = &h->table->v.vec[i];
-          val *iter;
-
-          for (iter = pchain; *iter; ) {
-            val entry = us_car(*iter);
-            if (!gc_is_reachable(us_car(entry)) || !gc_is_reachable(us_cdr(entry)))
-            {
-              *iter = us_cdr(*iter);
+         and values that are garbage. */
+      for (i = 0; i < h->modulus; i++) {
+        val *pchain = &h->table->v.vec[i];
+        val *iter;
+
+        for (iter = pchain; *iter; ) {
+          val entry = us_car(*iter);
+          if (!gc_is_reachable(us_car(entry)) && !gc_is_reachable(us_cdr(entry))) {
+            *iter = us_cdr(*iter);
 #if CONFIG_EXTRA_DEBUGGING
-              if (!gc_is_reachable(us_car(entry)) && us_car(entry) == break_obj)
-                breakpt();
-              if (!gc_is_reachable(us_cdr(entry)) && us_cdr(entry) == break_obj)
-                breakpt();
+            if (!gc_is_reachable(us_car(entry)) && us_car(entry) == break_obj)
+              breakpt();
+            if (!gc_is_reachable(us_cdr(entry)) && us_cdr(entry) == break_obj)
+              breakpt();
 #endif
-            } else {
-              iter = us_cdr_p(*iter);
-              c++;
-            }
+          } else {
+            iter = us_cdr_p(*iter);
+            c++;
           }
         }
-      } else {
-        for (i = 0; i < h->modulus; i++) {
-          val *pchain = &h->table->v.vec[i];
-          val *iter;
-
-          for (iter = pchain; *iter; ) {
-            val entry = us_car(*iter);
-            if (!gc_is_reachable(us_car(entry)) && !gc_is_reachable(us_cdr(entry)))
-            {
-              *iter = us_cdr(*iter);
+      }
+      break;
+    case hash_weak_or:
+      /* Sweep through all entries. Delete any which have keys
+         or values that are garbage. */
+      for (i = 0; i < h->modulus; i++) {
+        val *pchain = &h->table->v.vec[i];
+        val *iter;
+
+        for (iter = pchain; *iter; ) {
+          val entry = us_car(*iter);
+          if (!gc_is_reachable(us_car(entry)) || !gc_is_reachable(us_cdr(entry))) {
+            *iter = us_cdr(*iter);
 #if CONFIG_EXTRA_DEBUGGING
-              if (!gc_is_reachable(us_car(entry)) && us_car(entry) == break_obj)
-                breakpt();
-              if (!gc_is_reachable(us_cdr(entry)) && us_cdr(entry) == break_obj)
-                breakpt();
+            if (!gc_is_reachable(us_car(entry)) && us_car(entry) == break_obj)
+              breakpt();
+            if (!gc_is_reachable(us_cdr(entry)) && us_cdr(entry) == break_obj)
+              breakpt();
 #endif
-            } else {
-              iter = us_cdr_p(*iter);
-              c++;
-            }
+          } else {
+            iter = us_cdr_p(*iter);
+            c++;
           }
         }
       }
@@ -1404,7 +1405,8 @@ static val equal_based_p(val equal, val eql, val eq, val wkeys)
 
 val hashv(struct args *args)
 {
-  val wkeys = nil, wvals = nil, equal = nil, eql = nil;
+  val self = lit("hash");
+  val wkeys = nil, wvals = nil, equal = nil, eql = nil, wand = nil, wor = nil;
   val eq = nil, userdata = nil;
   struct args_bool_key akv[] = {
     { weak_keys_k, nil, &wkeys },
@@ -1412,14 +1414,31 @@ val hashv(struct args *args)
     { equal_based_k, nil, &equal },
     { eql_based_k, nil, &eql },
     { eq_based_k, nil, &eq },
+    { weak_and_k, nil, &wand },
+    { weak_or_k, nil, &wor },
     { userdata_k, t, &userdata }
   };
-  val ebp = (args_keys_extract(args, akv, sizeof akv / sizeof akv[0]),
-             equal_based_p(equal, eql, eq, wkeys));
-  val hash = if3(eq, make_eq_hash(wkeys, wvals), make_hash(wkeys, wvals, ebp));
-  if (userdata)
-    set_hash_userdata(hash, userdata);
-  return hash;
+
+  args_keys_extract(args, akv, sizeof akv / sizeof akv[0]);
+
+  if (wand && wor)
+    uw_throwf(error_s, lit("~a: both ~s and ~s specified"),
+              self, weak_and_k, weak_or_k, nao);
+
+  if (wand)
+    wkeys = weak_and_k;
+  else if (wor)
+    wkeys = weak_or_k;
+
+  {
+    val ebp = equal_based_p(equal, eql, eq, wkeys);
+    val hash = if3(eq,
+                   make_eq_hash(wkeys, wvals),
+                   make_hash(wkeys, wvals, ebp));
+    if (userdata)
+      set_hash_userdata(hash, userdata);
+    return hash;
+  }
 }
 
 val hashl(val arglist)
@@ -1943,6 +1962,8 @@ void hash_init(void)
 {
   weak_keys_k = intern(lit("weak-keys"), keyword_package);
   weak_vals_k = intern(lit("weak-vals"), keyword_package);
+  weak_and_k = intern(lit("weak-and"), keyword_package);
+  weak_or_k = intern(lit("weak-or"), keyword_package);
   equal_based_k = intern(lit("equal-based"), keyword_package);
   eql_based_k = intern(lit("eql-based"), keyword_package);
   eq_based_k = intern(lit("eq-based"), keyword_package);
diff --git a/hash.h b/hash.h
index 3b773a6b..ccc74032 100644
--- a/hash.h
+++ b/hash.h
@@ -25,6 +25,14 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
+typedef enum hash_flags {
+  hash_weak_none = 0,
+  hash_weak_keys = 1,
+  hash_weak_vals = 2,
+  hash_weak_or = 3,
+  hash_weak_and = 4,
+} hash_flags_t;
+
 struct hash_iter {
   struct hash_iter *next;
   val hash;
@@ -32,14 +40,14 @@ struct hash_iter {
   val cons;
 };
 
-extern val weak_keys_k, weak_vals_k, userdata_k;
+extern val weak_keys_k, weak_vals_k, weak_and_k, weak_or_k, userdata_k;
 extern val equal_based_k, eql_based_k, eq_based_k;
 
 extern struct cobj_class *hash_cls;
 
 ucnum equal_hash(val obj, int *count, ucnum);
 val make_seeded_hash(val weak_keys, val weak_vals, val equal_based, val seed);
-val tweak_hash(val hash, val weak_keys, val weak_vals);
+void tweak_hash(val hash, hash_flags_t);
 val make_hash(val weak_keys, val weak_vals, val equal_based);
 val make_eq_hash(val weak_keys, val weak_vals);
 val make_similar_hash(val existing);
diff --git a/lib.c b/lib.c
index 38f19af7..53db3ac0 100644
--- a/lib.c
+++ b/lib.c
@@ -14052,7 +14052,6 @@ int compat_fixup(int compat_ver)
 
   eval_compat_fixup(compat_ver);
   rand_compat_fixup(compat_ver);
-  parse_compat_fixup(compat_ver);
   arith_compat_fixup(compat_ver);
   ffi_compat_fixup(compat_ver);
   regex_compat_fixup(compat_ver);
diff --git a/parser.c b/parser.c
index 169b58b0..ff79ec3f 100644
--- a/parser.c
+++ b/parser.c
@@ -1878,7 +1878,7 @@ void parse_init(void)
   parser_cls = cobj_register(parser_s);
 
   protect(&stream_parser_hash, &unique_s, &catch_all, convert(val *, 0));
-  stream_parser_hash = make_hash(t, t, nil);
+  stream_parser_hash = make_hash(weak_and_k, nil, nil);
   catch_all = cons(t, nil);
 
   parser_l_init();
@@ -1897,9 +1897,3 @@ void parse_init(void)
   reg_fun(intern(lit("repl"), system_package), func_n4(repl));
   reg_mac(json_s, func_n2(me_json));
 }
-
-void parse_compat_fixup(int compat_ver)
-{
-  if (compat_ver <= 266)
-    tweak_hash(stream_parser_hash, t, nil);
-}
diff --git a/parser.h b/parser.h
index b504b083..3d682daa 100644
--- a/parser.h
+++ b/parser.h
@@ -148,4 +148,3 @@ val parser_set_lineno(val self, val stream, val lineno);
 val parser_errors(val parser);
 val parse_errors(val stream);
 void parse_init(void);
-void parse_compat_fixup(int compat_ver);
diff --git a/txr.1 b/txr.1
index 71da5676..5d91050b 100644
--- a/txr.1
+++ b/txr.1
@@ -51064,15 +51064,18 @@ entries disappear. This happens even if the values are themselves reachable.
 Vice versa, when an object appearing as a value in one or more weak-value hash
 tables becomes unreachable, those entries disappear, even if the keys are
 reachable. When a hash table has both weak keys and weak values, then an
-entry is removed when neither its key nor its value is reachable.  In other
-words, if either the key or value is reachable, the entry is retained.
-Note: this behavior differed in \*(TX 266 and earlier versions.
+the behavior is one of two possible semantics. Under the
+.codn or -semantics,
+the hash table entry is removed if either the key or the value is unreachable.
+Under the
+.codn and -semantics,
+the entry is removed only if both the key and value are unreachable.
 
 If the keys of a weak-key hash table are reachable from the values, or if the
 values of a weak-key hash table are reachable from the keys, then the weak
 semantics is defeated for the affected entries: the hash table retains those
 entries as if it were an ordinary table.  A hash table with both weak keys and
-values does not have this issue.
+values does not have this issue, regardless of its semantics.
 
 An open traversal of a hash table is performed by the
 .code maphash
@@ -51123,7 +51126,7 @@ becomes unspecified.
 These functions construct a new hash table.
 
 .code make-hash
-takes three mandatory Boolean arguments. The
+takes three mandatory Boolean arguments. The Boolean
 .meta weak-keys
 argument specifies whether the hash table shall have weak keys. The
 .meta weak-vals
@@ -51131,6 +51134,39 @@ argument specifies whether it shall have weak values, and
 .meta equal-based
 specifies whether it is
 .codn equal -based.
+
+If the
+.meta weak-keys
+argument is one of the keywords
+.code :weak-and
+or
+.code :weak-or
+then the hash table shall have both weak keys and weak values, with the
+semantics implied by the keyword:
+.code :weak-and
+specifies
+.codn and -semantics
+and
+.code :weak-or
+specifies
+code or -semantics.
+The
+.meta weak-vals
+argument is then ignored.
+
+If both
+.meta weak-keys
+and
+.meta weak-values
+are true, and
+.meta weak-keys
+is not one of the keywords
+.code :weak-and
+or
+.codn :weak-or ,
+then the hash table has
+.codn or -semantics.
+
 The
 .code hash
 function defaults all three of these properties to false,
@@ -51159,6 +51195,8 @@ function provides an alternative interface. It accepts optional
 keyword arguments. The supported keyword symbols are:
 .codn :weak-keys ,
 .codn :weak-vals ,
+.codn :weak-and ,
+.codn :weak-or ,
 .codn :equal-based ,
 .code :eql-based
 .code :eq-based
@@ -51185,11 +51223,33 @@ function produces an
 hash table by default.
 
 If
-.code :weak-keys
+.codn :weak-keys ,
+.code :weak-and
+or
+.code :weak-or
 is specified, then
 .code :equal-based
 may not be specified.
 
+At most one of
+.code :weak-and
+or
+.code :weak-or
+may be specified. If either of these is specified, then the
+.code :weak-keys
+and
+.code :weak-values
+keywords are redundant and unnecessary.
+
+If
+.code :weak-keys
+and
+.code :weak-values
+are both specified, and
+.code :weak-and
+isn't specified, the situation is equivalent to
+.codn :weak-or .
+
 If
 .code :userdata
 is present, it must be followed by an argument value; that value
@@ -83088,13 +83148,6 @@ of these version values, the described behaviors are provided if
 is given an argument which is equal or lower. For instance
 .code "-C 103"
 selects the behaviors described below for version 105, but not those for 102.
-.IP 266
-Until \*(TX 266, hash tables with both weak values and keys are subject to
-a conjunctive rule for entry retention: entries are retained if both the
-key and value are reachable objects. If either the key or value is unreachable,
-the entry is eligible for removal. The behavior changed in favor of a disjunctive
-rule: the hash entry is retained if either the key or value is reachable.
-A compatibility option value of 266 or lower restores the old behavior.
 .IP 265
 Until \*(TX 265, the
 .code with-resources