Implementing #H((...) ...) read/print syntax for hash tables.

* hash.c (print_key_val, hash_print_op): New static functions.
(hash_ops): hash_print_op wired in in place of cobj_print_op.

* parser.l (HASH_H): New token recognized.

* parser.y (HASH_H): New terminal symbol.
(hash): New nonterminal symbol.
(expr): Acquires hash as a constituent.
(hash_from_notation): New static function.

* txr.1: Hash syntax described.

* txr.vim: Updated.

5 files changed, 79 insertions, 5 deletions

diff --git a/hash.c b/hash.c
index f8bba6bd..bc086ae9 100644
--- a/hash.c
+++ b/hash.c
@@ -36,6 +36,7 @@
 #include "lib.h"
 #include "gc.h"
 #include "unwind.h"
+#include "stream.h"
 #include "hash.h"
 
 typedef enum hash_flags {
@@ -184,6 +185,44 @@ cnum cobj_hash_op(val obj)
   abort();
 }
 
+static val print_key_val(val out, val key, val value)
+{
+  format(out, lit(" (~s ~s)"), key, value, nao);
+  return nil;
+}
+
+static void hash_print_op(val hash, val out)
+{
+  struct hash *h = (struct hash *) hash->co.handle;
+  int need_space = 0;
+
+  put_string(lit("#H(("), out);
+  if (h->hash_fun == equal_hash) {
+    obj_print(equal_based_k, out);
+    need_space = 1;
+  }
+  if (h->flags != hash_weak_none) {
+    if (need_space)
+      put_string(lit(" "), out);
+    switch (h->flags) {
+    case hash_weak_both:
+      obj_print(weak_keys_k, out);
+      /* fallthrough */
+    case hash_weak_vals:
+      obj_print(weak_vals_k, out);
+      break;
+    case hash_weak_keys:
+      obj_print(weak_keys_k, out);
+      break;
+    default:
+      break;
+    }
+  }
+  put_string(lit(")"), out);
+  maphash(curry_123_23(func_n3(print_key_val), out), hash);
+  put_string(lit(")"), out);
+}
+
 static void hash_mark(val hash)
 {
   struct hash *h = (struct hash *) hash->co.handle;
@@ -236,7 +275,7 @@ static void hash_mark(val hash)
 
 static struct cobj_ops hash_ops = {
   cobj_equal_op,
-  cobj_print_op,
+  hash_print_op,
   cobj_destroy_free_op,
   hash_mark,
   cobj_hash_op
diff --git a/parser.l b/parser.l
index f7a655db..76ba8203 100644
--- a/parser.l
+++ b/parser.l
@@ -461,6 +461,11 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return '#';
 }
 
+<NESTED,BRACED>#H {
+  yylval.lineno = lineno;
+  return HASH_H;
+}
+
 <NESTED>\.\. {
   yylval.lineno = lineno;
   return DOTDOT;
diff --git a/parser.y b/parser.y
index 9a712d64..68fe03f0 100644
--- a/parser.y
+++ b/parser.y
@@ -53,6 +53,7 @@ static val lit_char_helper(val litchars);
 static val optimize_text(val text_form);
 static val choose_quote(val quoted_form);
 static wchar_t char_from_name(wchar_t *name);
+static val hash_from_notation(val notation);
 
 static val parsed_spec;
 
@@ -72,7 +73,7 @@ static val parsed_spec;
 %token <lineno> UNTIL COLL OUTPUT REPEAT REP SINGLE FIRST LAST EMPTY 
 %token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY
 %token <lineno> ERRTOK /* deliberately not used in grammar */
-%token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT
+%token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H
 
 %token <val> NUMBER METANUM
 
@@ -85,7 +86,7 @@ static val parsed_spec;
 %type <val> clause_parts additional_parts gather_parts additional_gather_parts
 %type <val> output_clause define_clause try_clause catch_clauses_opt
 %type <val> line elems_opt elems clause_parts_h additional_parts_h
-%type <val> text texts elem var var_op modifiers meta_expr vector
+%type <val> text texts elem var var_op modifiers meta_expr vector hash
 %type <val> list exprs exprs_opt expr out_clauses out_clauses_opt out_clause
 %type <val> repeat_clause repeat_parts_opt o_line
 %type <val> o_elems_opt o_elems o_elem o_var rep_elem rep_parts_opt
@@ -670,6 +671,9 @@ o_var : IDENT                   { $$ = list(var_s, intern(string_own($1), nil),
 vector : '#' list               { $$ = rlcp(vector_list($2), $2); }
        ;
 
+hash : HASH_H list              { $$ = rlcp(hash_from_notation($2), num($1)); }
+     ;
+
 list : '(' exprs ')'            { $$ = rl($2, num($1)); }
      | '(' ')'                  { $$ = nil; }
      | '[' exprs ']'            { $$ = rl(cons(dwim_s, $2), num($1)); }
@@ -724,6 +728,7 @@ expr : IDENT                    { $$ = rl(intern(string_own($1), nil),
      | NUMBER                   { $$ = $1; }
      | list                     { $$ = $1; }
      | vector                   { $$ = $1; }
+     | hash                     { $$ = $1; }
      | meta_expr                { $$ = $1; }
      | lisp_regex               { $$ = cons(regex_compile(rest($1)),
                                             rest($1));
@@ -1069,6 +1074,19 @@ static wchar_t char_from_name(wchar_t *name)
   return L'!'; /* code meaning not found */
 }
 
+static val hash_from_notation(val notation)
+{
+  val hash = hashv(first(notation));
+  val iter = rest(notation);
+
+  for (; iter; iter = cdr(iter)) {
+    val entry = car(iter);
+    sethash(hash, first(entry), second(entry));
+  }
+
+  return hash;
+}
+
 val get_spec(void)
 {
   return parsed_spec;
diff --git a/txr.1 b/txr.1
index b51813d2..45718727 100644
--- a/txr.1
+++ b/txr.1
@@ -4476,6 +4476,7 @@ list, which terminates nonempty lists.
 
 Function and variable bindings are dynamically scoped in TXR Lisp. However,
 closures do capture variables.
+
 .SS Additional Syntax
 
 Much of the TXR Lisp syntax has been introduced in the previous sections of the
@@ -4542,11 +4543,22 @@ and not a quasiquote.
 
 .SS Vectors
 
-.IP #(...)
+.IP "#(...)"
 
 A hash token followed by a list denotes a vector. For example #(1 2 a)
 is a three-element vector containing the numbers 1 and 2, and the symbol a.
 
+.SS Hashes
+
+.IP "#H((<hash-argument>*) (<key> <value>)*)"
+
+The notation #H followed by a nested list syntax denotes a hash table literal.
+The first item in the syntax is a list of keywords. These are the same
+keywords as are used when calling the function hash to construct
+a hash table. Allowed keywords are: :equal-based, :weak-keys, :weak-values.
+An empty list can be specified as nil or (), which defaults to a
+hash table basd on the eq function, with no weak semantics.
+
 .SS Nested Quotes
 
 Quotes can be nested.  What if it is necessary to unquote something in the
diff --git a/txr.vim b/txr.vim
index 4bf697ef..2baf3ae4 100644
--- a/txr.vim
+++ b/txr.vim
@@ -120,7 +120,7 @@ syn region txr_bracevar matchgroup=Delimiter start="@[ \t]*[*]\?{" matchgroup=De
 
 syn region txr_directive matchgroup=Delimiter start="@[ \t]*(" matchgroup=Delimiter end=")" contains=txr_keyword,txr_string,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_num,txl_ident,txl_regex,txr_string,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error
 
-syn region txr_list contained matchgroup=Delimiter start="#\?(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error
+syn region txr_list contained matchgroup=Delimiter start="#\?H\?(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error
 
 syn region txr_bracket contained matchgroup=Delimiter start="\[" matchgroup=Delimiter end="\]" contains=txl_keyword,txr_string,txl_regex,txr_num,txl_ident,txr_metanum,txr_list,txr_bracket,txr_mlist,txr_mbracket,txr_quasilit,txr_chr,txr_quote,txr_unquote,txr_splice,txr_dot,txr_dotdot,txr_ncomment,txr_nested_error