New data type: tnode.

Binary search tree nodes are being added as a basic heap data
type. The C type tag is TNOD, and the Lisp type is tnode.

Binary search tree nodes have three elements: a key, a left
child and a right child.

The printed notation is #N(key left right). Quasiquoting
is supported: ^#N(,foo ,bar) but not splicing.

Because tnodes have three elements, they they fit into TXR's
four-word heap cell, not requiring any additional memory
allocation.

These nodes are going to be the basis for a binary search tree
container, which will use the scapegoat tree algorithm for
maintaining balance.

* tree.c, tree.h: New files.

* Makefile (OBJS): Adding tree.o.

* eval.c (expand_qquote_rec): Recurse through tnode cells,
so unquotes work inside #N syntax.

* gc.c (finalize): Add TNOD to no-op case in switch; tnodes
don't require finalization.
(mark_obj): Traverse tnode cell.

* hash.c (equal_hash): Add TNOD case.

* lib.c (tnode_s): New symbol variable.
(seq_kind_tab): New entry for TNOD, mapping to SEQ_NOTSEQ.
(code2type, equal): Handle TNOD.
(obj_init): Initialize tnode_s variable.
(obj_print_impl, populate_obj_hash): Handle TNOD.
(init): Call tree_init function in tree.c.

* lib.h (enum type, type_t): New enumeration TNOD.
(struct tnod): New struct type.
(union obj, obj_t): New union member tn of type struct tnod.
(tnode_s): Declard.

* parserc.c (circ_backpatch): Handle TNOD, so circular
notation works through tnode cells.

* parser.l (grammar): Recognize #N prefix, mapping to
HASH_N token.

* parser.y (HASH_N): New grammar terminal symbol.
(tnode): New nonterminal symbol.
(i_expr, n_expr): Add tnode cases to productions.
(yybadtoken): Map HASH_N to "#N" string.

11 files changed, 220 insertions, 5 deletions

diff --git a/Makefile b/Makefile
index a29ca5ae..0aaf7494 100644
--- a/Makefile
+++ b/Makefile
@@ -53,6 +53,7 @@ OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o
 OBJS += arith.o hash.o utf8.o filter.o eval.o parser.o rand.o combi.o sysif.o
 OBJS += args.o lisplib.o cadr.o struct.o itypes.o buf.o jmp.o protsym.o ffi.o
 OBJS += strudel.o vm.o chksum.o chksums/sha256.o chksums/crc32.o chksums/md5.o
+OBJS += tree.o
 OBJS-$(debug_support) += debug.o
 OBJS-$(have_syslog) += syslog.o
 OBJS-$(have_glob) += glob.o
diff --git a/eval.c b/eval.c
index 0058b961..a2b60120 100644
--- a/eval.c
+++ b/eval.c
@@ -54,6 +54,7 @@
 #include "struct.h"
 #include "cadr.h"
 #include "filter.h"
+#include "tree.h"
 #include "vm.h"
 #include "eval.h"
 
@@ -3464,6 +3465,11 @@ static val expand_qquote_rec(val qquoted_form, val qq, val unq, val spl)
     val frexp = expand_qquote(from(qquoted_form), qq, unq, spl);
     val toexp = expand_qquote(to(qquoted_form), qq, unq, spl);
     return rlcp(list(rcons_s, frexp, toexp, nao), qquoted_form);
+  } else if (tnodep(qquoted_form)) {
+    val kyexp = expand_qquote(key(qquoted_form), qq, unq, spl);
+    val leexp = expand_qquote(left(qquoted_form), qq, unq, spl);
+    val riexp = expand_qquote(right(qquoted_form), qq, unq, spl);
+    return rlcp(list(tnode_s, kyexp, leexp, riexp, nao), qquoted_form);
   } else if (atom(qquoted_form)) {
     return cons(quote_s, cons(qquoted_form, nil));
   } else {
diff --git a/gc.c b/gc.c
index 93004338..93a91267 100644
--- a/gc.c
+++ b/gc.c
@@ -266,6 +266,7 @@ static void finalize(val obj)
   case ENV:
   case FLNUM:
   case RNG:
+  case TNOD:
     return;
   case SYM:
     free(obj->s.slot_cache);
@@ -417,6 +418,10 @@ tail_call:
   case BUF:
     mark_obj(obj->b.len);
     mark_obj_tail(obj->b.size);
+  case TNOD:
+    mark_obj(obj->tn.left);
+    mark_obj(obj->tn.right);
+    mark_obj_tail(obj->tn.key);
   }
 
   assert (0 && "corrupt type field");
diff --git a/hash.c b/hash.c
index e01dc9fc..40833283 100644
--- a/hash.c
+++ b/hash.c
@@ -258,6 +258,10 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
             + equal_hash(obj->rn.to, count, seed + (RNG << 8));
   case BUF:
     return hash_buf(obj->b.data, c_unum(obj->b.len), seed);
+  case TNOD:
+    return equal_hash(obj->tn.left, count, (seed + TNOD))
+            + equal_hash(obj->tn.right, count, seed + (TNOD << 8));
+            + equal_hash(obj->tn.key, count, seed + (TNOD << 16));
   }
 
   internal_error("unhandled case in equal function");
diff --git a/lib.c b/lib.c
index ebea0d00..f0e92f2f 100644
--- a/lib.c
+++ b/lib.c
@@ -53,6 +53,7 @@
 #include "arith.h"
 #include "rand.h"
 #include "hash.h"
+#include "tree.h"
 #include "signal.h"
 #include "unwind.h"
 #include "args.h"
@@ -94,7 +95,7 @@ val package_s, system_package_s, keyword_package_s, user_package_s;
 val null_s, t, cons_s, str_s, chr_s, fixnum_s, sym_s, pkg_s, fun_s, vec_s;
 val lit_s, stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
 val atom_s, integer_s, number_s, sequence_s, string_s;
-val env_s, bignum_s, float_s, range_s, rcons_s, buf_s;
+val env_s, bignum_s, float_s, range_s, rcons_s, buf_s, tnode_s;
 val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 val nongreedy_s;
 val quote_s, qquote_s, unquote_s, splice_s;
@@ -155,6 +156,7 @@ const seq_kind_t seq_kind_tab[MAXTYPE+1] = {
   SEQ_NOTSEQ,   /* FLNUM */
   SEQ_NOTSEQ,   /* RNG */
   SEQ_VECLIKE,  /* BUF */
+  SEQ_NOTSEQ,   /* TNOD */
 };
 
 val identity(val obj)
@@ -184,6 +186,7 @@ static val code2type(int code)
   case FLNUM: return float_s;
   case RNG: return range_s;
   case BUF: return buf_s;
+  case TNOD: return tnode_s;
   }
   return nil;
 }
@@ -2824,6 +2827,15 @@ val equal(val left, val right)
         return t;
     }
     break;
+  case TNOD:
+    if (type(right) == TNOD) {
+      if (equal(left->tn.key, right->tn.key) &&
+          equal(left->tn.left, right->tn.left) &&
+          equal(left->tn.right, right->tn.right))
+        return t;
+      return nil;
+    }
+    break;
   case COBJ:
     if (left->co.ops->equalsub) {
       val lsub = left->co.ops->equalsub(left);
@@ -10956,6 +10968,7 @@ static void obj_init(void)
   range_s = intern(lit("range"), user_package);
   rcons_s = intern(lit("rcons"), user_package);
   buf_s = intern(lit("buf"), user_package);
+  tnode_s = intern(lit("tnode"), user_package);
   var_s = intern(lit("var"), system_package);
   expr_s = intern(lit("expr"), system_package);
   regex_s = intern(lit("regex"), user_package);
@@ -11696,6 +11709,10 @@ dot:
     else
       buf_print(obj, out);
     break;
+  case TNOD:
+    format(out, if3(pretty, lit("#N(~a ~a ~a)"), lit("#N(~s ~s ~s)")),
+           obj->tn.key, obj->tn.left, obj->tn.right, nao);
+    break;
   default:
     format(out, lit("#<garbage: ~p>"), obj, nao);
     break;
@@ -11760,6 +11777,13 @@ tail:
       obj = to(obj);
       goto tail;
     }
+  case TNOD:
+    {
+      populate_obj_hash(obj->tn.left, ctx);
+      populate_obj_hash(obj->tn.right, ctx);
+      obj = obj->tn.key;
+      goto tail;
+    }
   case COBJ:
     if (hashp(obj)) {
       val iter = hash_begin(obj);
@@ -12358,6 +12382,7 @@ void init(val *stack_bottom)
   eval_init();
   hash_init();
   struct_init();
+  tree_init();
   itypes_init();
   buf_init();
   ffi_init();
diff --git a/lib.h b/lib.h
index 9368cb08..e47b84c6 100644
--- a/lib.h
+++ b/lib.h
@@ -67,7 +67,7 @@ typedef double_uintptr_t dbl_ucnum;
 typedef enum type {
   NIL = TAG_PTR, NUM = TAG_NUM, CHR = TAG_CHR, LIT = TAG_LIT, CONS,
   STR, SYM, PKG, FUN, VEC, LCONS, LSTR, COBJ, CPTR, ENV,
-  BGNUM, FLNUM, RNG, BUF, MAXTYPE = BUF
+  BGNUM, FLNUM, RNG, BUF, TNOD, MAXTYPE = TNOD
   /* If extending, check TYPE_SHIFT and all ocurrences of MAX_TYPE */
 } type_t;
 
@@ -300,6 +300,12 @@ struct buf {
   val size;
 };
 
+struct tnod {
+  obj_common;
+  val left, right;
+  val key;
+};
+
 union obj {
   struct any t;
   struct cons c;
@@ -317,6 +323,7 @@ union obj {
   struct flonum fl;
   struct range rn;
   struct buf b;
+  struct tnod tn;
 };
 
 #if CONFIG_GEN_GC
@@ -476,7 +483,7 @@ extern val null_s, t, cons_s, str_s, chr_s, fixnum_sl;
 extern val sym_s, pkg_s, fun_s, vec_s;
 extern val stream_s, hash_s, hash_iter_s, lcons_s, lstr_s, cobj_s, cptr_s;
 extern val atom_s, integer_s, number_s, sequence_s, string_s;
-extern val env_s, bignum_s, float_s, range_s, rcons_s, buf_s;
+extern val env_s, bignum_s, float_s, range_s, rcons_s, buf_s, tnode_s;
 extern val var_s, expr_s, regex_s, chset_s, set_s, cset_s, wild_s, oneplus_s;
 extern val nongreedy_s;
 extern val quote_s, qquote_s, unquote_s, splice_s;
diff --git a/parser.c b/parser.c
index 584a923a..d8619832 100644
--- a/parser.c
+++ b/parser.c
@@ -336,6 +336,31 @@ tail:
       obj = e;
       goto tail;
     }
+  case TNOD:
+    {
+      val k = obj->tn.key;
+      val l = obj->tn.left;
+      val r = obj->tn.right;
+      val rk = patch_ref(p, k);
+      val rl = patch_ref(p, l);
+      val rr = patch_ref(p, r);
+
+      if (rl)
+        set(mkloc(obj->tn.left, obj), rl);
+      else
+        circ_backpatch(p, &cs, l);
+
+      if (rr)
+        set(mkloc(obj->tn.right, obj), rr);
+      else
+        circ_backpatch(p, &cs, r);
+
+      if (rk)
+        set(mkloc(obj->tn.key, obj), rk);
+
+      obj = k;
+      goto tail;
+    }
   case COBJ:
     if (hashp(obj)) {
       val u = get_hash_userdata(obj);
diff --git a/parser.l b/parser.l
index 60e06727..a227a8b0 100644
--- a/parser.l
+++ b/parser.l
@@ -734,6 +734,11 @@ UONLY   {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
   return HASH_R;
 }
 
+<NESTED,BRACED>#N {
+  yylval->lineno = yyextra->lineno;
+  return HASH_N;
+}
+
 <NESTED,BRACED>#; {
   yylval->lineno = yyextra->lineno;
   return HASH_SEMI;
diff --git a/parser.y b/parser.y
index bc3488f5..55a364b1 100644
--- a/parser.y
+++ b/parser.y
@@ -47,6 +47,7 @@
 #include "hash.h"
 #include "struct.h"
 #include "eval.h"
+#include "tree.h"
 #include "y.tab.h"
 #include "gc.h"
 #include "debug.h"
@@ -118,7 +119,7 @@ INLINE val expand_form_ver(val form, int ver)
 %token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY IF
 %token <lineno> ERRTOK /* deliberately not used in grammar */
 %token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H HASH_S HASH_R HASH_SEMI
-%token <lineno> HASH_B_QUOTE
+%token <lineno> HASH_B_QUOTE HASH_N
 %token <lineno> WORDS WSPLICE QWORDS QWSPLICE
 %token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E SECRET_ESCAPE_I
 %token <lineno> OLD_DOTDOT
@@ -137,7 +138,7 @@ INLINE val expand_form_ver(val form, int ver)
 %type <val> output_clause define_clause try_clause catch_clauses_opt
 %type <val> if_clause elif_clauses_opt else_clause_opt
 %type <val> line elems_opt elems clause_parts_h additional_parts_h
-%type <val> text texts elem var var_op modifiers vector hash struct range
+%type <val> text texts elem var var_op modifiers vector hash struct range tnode
 %type <val> exprs exprs_opt n_exprs r_exprs i_expr i_dot_expr
 %type <val> n_expr n_exprs_opt n_dot_expr
 %type <val> list dwim meta compound
@@ -856,6 +857,15 @@ range : HASH_R list             { if (length($2) != two)
                                   yybadtok(yychar, lit("range literal")); }
       ;
 
+tnode : HASH_N list             { if (gt(length($2), three))
+                                    yyerr("excess elements in tree node");
+                                  { val tn = tnode(first($2), second($2),
+                                                   third($2));
+                                    $$ = rl(tn, num($1)); } }
+      | HASH_N error            { $$ = nil;
+                                  yybadtok(yychar, lit("tree node literal")); }
+      ;
+
 list : '(' n_exprs ')'          { $$ = rl($2, num($1)); }
      | '(' '.' n_exprs ')'      { val a = car($3);
                                   val ur = uref_helper(parser, a);
@@ -960,6 +970,7 @@ i_expr : SYMTOK                 { $$ = ifnign(symhlpr($1, t)); }
        | hash                   { $$ = $1; }
        | struct                 { $$ = $1; }
        | range                  { $$ = $1; }
+       | tnode                  { $$ = $1; }
        | lisp_regex             { $$ = $1; }
        | chrlit                 { $$ = $1; }
        | strlit                 { $$ = $1; }
@@ -999,6 +1010,7 @@ n_expr : SYMTOK                 { $$ = ifnign(symhlpr($1, t)); }
        | hash                   { $$ = $1; }
        | struct                 { $$ = $1; }
        | range                  { $$ = $1; }
+       | tnode                  { $$ = $1; }
        | lisp_regex             { $$ = $1; }
        | chrlit                 { $$ = $1; }
        | strlit                 { $$ = $1; }
@@ -1811,6 +1823,7 @@ void yybadtoken(parser_t *parser, int tok, val context)
   case HASH_H:         problem = lit("#H"); break;
   case HASH_S:         problem = lit("#S"); break;
   case HASH_R:         problem = lit("#R"); break;
+  case HASH_N:         problem = lit("#N"); break;
   case HASH_SEMI:      problem = lit("#;"); break;
   case HASH_N_EQUALS:  problem = lit("#<n>="); break;
   case HASH_N_HASH:    problem = lit("#<n>#"); break;
diff --git a/tree.c b/tree.c
new file mode 100644
index 00000000..205d5b84
--- /dev/null
+++ b/tree.c
@@ -0,0 +1,91 @@
+/* Copyright 2019
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ *    list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+#include <stddef.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <signal.h>
+#include "config.h"
+#include "alloca.h"
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include "lib.h"
+#include "gc.h"
+#include "args.h"
+#include "txr.h"
+#include "signal.h"
+#include "unwind.h"
+#include "stream.h"
+#include "eval.h"
+#include "itypes.h"
+#include "arith.h"
+#include "tree.h"
+
+val tnode(val key, val left, val right)
+{
+  val obj = make_obj();
+  obj->tn.type = TNOD;
+  obj->tn.left = left;
+  obj->tn.right = right;
+  obj->tn.key = key;
+  return obj;
+}
+
+val tnodep(val obj)
+{
+  return tnil(type(obj) == TNOD);
+}
+
+val left(val node)
+{
+  type_check(lit("left"), node, TNOD);
+  return node->tn.left;
+}
+
+val right(val node)
+{
+  type_check(lit("right"), node, TNOD);
+  return node->tn.right;
+}
+
+val key(val node)
+{
+  type_check(lit("key"), node, TNOD);
+  return node->tn.key;
+}
+
+void tree_init(void)
+{
+  reg_fun(tnode_s, func_n3(tnode));
+  reg_fun(intern(lit("left"), user_package), func_n1(left));
+  reg_fun(intern(lit("right"), user_package), func_n1(right));
+  reg_fun(intern(lit("key"), user_package), func_n1(key));
+}
diff --git a/tree.h b/tree.h
new file mode 100644
index 00000000..8876f524
--- /dev/null
+++ b/tree.h
@@ -0,0 +1,33 @@
+/* Copyright 2009-2019
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ *    list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ *    this list of conditions and the following disclaimer in the documentation
+ *    and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+val tnode(val key, val left, val right);
+val tnodep(val obj);
+val left(val node);
+val right(val node);
+val key(val node);
+void tree_init(void);