From 6d7ae0d677f9c507d15af86cf51f365d6248401d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 22 Sep 2019 16:11:33 -0700
Subject: 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.
---
 lib.c | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

(limited to 'lib.c')

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();
-- 
cgit v1.2.3