Infrastructure for storing line number information

outside of the code, in hash tables.

* filter.c (make_trie, trie_add): Update to three-argument
make_hash.

* hash.c (struct hash): New members, hash_fun, assoc_fun
acons_new_l_fun.
(ll_hash): Renamed to equal_hash.
(eql_hash): New static function.
(cobj_hash_op): Follows ll_hash rename.
(hash_grow): Use new function indirection to call hashing function.
(make_hash): New argument to specify type of hashing. Initialize new
members of struct hash.
(gethash_l, gethash, remhash): Use function indirection for hashing and
chain search and update.
(pushhash): New function.

* hash.h (make_hash): Declaration updated with new parameter.
(pushhash): Declared.

* lib.c (eql_f): New global variable.
(eql, assq, aconsq_new, aconsq_new_l): New functions.
(make_package): Updated to new three-argument make_hash.
(obj_init): gc-protect and initialize new variable eql_f.

* lib.h (eql, assq, aconsq_new, aconsq_new_l): Declared.

* match.c (dir_tables_init): Updated to there-argument make_hash.

* parser.h (form_to_ln_hash, ln_to_forms_hash): Global variables
declared.

* parser.l (form_to_ln_hash, ln_to_forms_hash): New global variables.
(grammar): Set yylval.lineno for tokens that are classified to
that type in parser.y.
(parse_init): Initialize and gc-protect new global variables.

* parser.y (rl): New static helper function.
(%union): New member, lineno.
(ALL, SOME, NONE, MAYBE, CASES, CHOOSE, GATHER,
AND, OR, END, COLLECT, UNTIL, COLL, OUTPUT, REPEAT,
REP, SINGLE, FIRST, LAST, EMPTY, DEFINE,
TRY, CATCH, FINALLY, ERRTOK, '('): Reclassified as lineno type.
In the grammar, these keywords can thus provide a stable line number
from the lexer.
(grammar): Numerous rules updated to add constructs to the
line number hash tables via the rl helper.

* dep.mk: Updated.

* Makefile (depend): Use the installed, stable txr in the
system path to update dependencies rather than locally built ./txr, to
prevent the problem that txr is broken because out out-of-date
dependencies, and thus cannot regenerate dependencies.

1 files changed, 41 insertions, 18 deletions

diff --git a/hash.c b/hash.c
index 8ee7a072..7ee39d43 100644
--- a/hash.c
+++ b/hash.c
@@ -52,6 +52,9 @@ struct hash {
   cnum modulus;
   cnum count;
   val userdata;
+  cnum (*hash_fun)(val);
+  val (*assoc_fun)(val list, val key);
+  val *(*acons_new_l_fun)(val *list, val key, val *new_p);
 };
 
 struct hash_iter {
@@ -84,7 +87,7 @@ static long hash_c_str(const wchar_t *str)
   return h;
 }
 
-static cnum ll_hash(val obj)
+static cnum equal_hash(val obj)
 {
   if (obj == nil)
     return NUM_MAX;
@@ -93,7 +96,7 @@ static cnum ll_hash(val obj)
   case LIT:
     return hash_c_str(litptr(obj));
   case CONS:
-    return (ll_hash(obj->c.car) + ll_hash(obj->c.cdr)) & NUM_MAX;
+    return (equal_hash(obj->c.car) + equal_hash(obj->c.cdr)) & NUM_MAX;
   case STR:
     return hash_c_str(obj->st.str);
   case CHR:
@@ -110,23 +113,23 @@ static cnum ll_hash(val obj)
     }
     break;
   case FUN:
-    return ((cnum) obj->f.f.interp_fun + ll_hash(obj->f.env)) & NUM_MAX;
+    return ((cnum) obj->f.f.interp_fun + equal_hash(obj->f.env)) & NUM_MAX;
   case VEC:
     {
       val fill = obj->v.vec[vec_fill];
-      cnum i, h = ll_hash(obj->v.vec[vec_fill]);
+      cnum i, h = equal_hash(obj->v.vec[vec_fill]);
       cnum len = c_num(fill);
 
       for (i = 0; i < len; i++)
-        h = (h + ll_hash(obj->v.vec[i])) & NUM_MAX;
+        h = (h + equal_hash(obj->v.vec[i])) & NUM_MAX;
 
       return h;
     }
   case LCONS:
-    return (ll_hash(car(obj)) + ll_hash(cdr(obj))) & NUM_MAX;
+    return (equal_hash(car(obj)) + equal_hash(cdr(obj))) & NUM_MAX;
   case LSTR:
     lazy_str_force(obj);
-    return ll_hash(obj->ls.prefix);
+    return equal_hash(obj->ls.prefix);
   case COBJ:
     return obj->co.ops->hash(obj);
   }
@@ -134,6 +137,16 @@ static cnum ll_hash(val obj)
   internal_error("unhandled case in equal function");
 }
 
+static cnum eql_hash(val obj)
+{
+    switch (sizeof (mem_t *)) {
+    case 4:
+      return (((cnum) obj) & NUM_MAX) >> 4;
+    case 8: default:
+      return (((cnum) obj) & NUM_MAX) >> 5;
+    }
+}
+
 cnum cobj_hash_op(val obj)
 {
   return ((cnum) obj) & NUM_MAX;
@@ -141,7 +154,7 @@ cnum cobj_hash_op(val obj)
 
 val hash_obj(val obj)
 {
-  return num(ll_hash(obj));
+  return num(equal_hash(obj));
 }
 
 static void hash_mark(val hash)
@@ -219,8 +232,7 @@ static void hash_grow(struct hash *h)
       val entry = car(conses);
       val next = cdr(conses);
       val key = car(entry);
-      val *pchain = vecref_l(new_table,
-                                num(ll_hash(key) % new_modulus));
+      val *pchain = vecref_l(new_table, num(h->hash_fun(key) % new_modulus));
       *cdr_l(conses) = *pchain;
       *pchain = conses;
       conses = next;
@@ -231,7 +243,7 @@ static void hash_grow(struct hash *h)
   h->table = new_table;
 }
 
-val make_hash(val weak_keys, val weak_vals)
+val make_hash(val weak_keys, val weak_vals, val equal_based)
 {
   int flags = ((weak_vals != nil) << 1) | (weak_keys != nil);
   struct hash *h = (struct hash *) chk_malloc(sizeof *h);
@@ -247,15 +259,19 @@ val make_hash(val weak_keys, val weak_vals)
   h->table = table;
   h->userdata = nil;
 
+  h->hash_fun = equal_based ? equal_hash : eql_hash;
+  h->assoc_fun = equal_based ? assoc : assq;
+  h->acons_new_l_fun = equal_based ? acons_new_l : aconsq_new_l;
+
   return hash;
 }
 
 val *gethash_l(val hash, val key, val *new_p)
 {
   struct hash *h = (struct hash *) hash->co.handle;
-  val *pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus));
+  val *pchain = vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
   val old = *pchain;
-  val *place = acons_new_l(pchain, key, new_p);
+  val *place = h->acons_new_l_fun(pchain, key, new_p);
   if (old != *pchain && ++h->count > 2 * h->modulus)
     hash_grow(h);
   return place;
@@ -264,16 +280,16 @@ val *gethash_l(val hash, val key, val *new_p)
 val gethash(val hash, val key)
 {
   struct hash *h = (struct hash *) hash->co.handle;
-  val chain = *vecref_l(h->table, num(ll_hash(key) % h->modulus));
-  val found = assoc(chain, key);
+  val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
+  val found = h->assoc_fun(chain, key);
   return cdr(found);
 }
 
 val gethash_f(val hash, val key, val *found)
 {
   struct hash *h = (struct hash *) hash->co.handle;
-  val chain = *vecref_l(h->table, num(ll_hash(key) % h->modulus));
-  *found = assoc(chain, key);
+  val chain = *vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
+  *found = h->assoc_fun(chain, key);
   return cdr(*found);
 }
 
@@ -284,10 +300,17 @@ val sethash(val hash, val key, val value)
   return new_p;
 }
 
+val pushhash(val hash, val key, val value)
+{
+  val new_p;
+  push(value, gethash_l(hash, key, &new_p));
+  return new_p;
+}
+
 val remhash(val hash, val key)
 {
   struct hash *h = (struct hash *) hash->co.handle;
-  val *pchain = vecref_l(h->table, num(ll_hash(key) % h->modulus));
+  val *pchain = vecref_l(h->table, num(h->hash_fun(key) % h->modulus));
   *pchain = alist_remove1(*pchain, key);
   h->count--;
   bug_unless (h->count >= 0);