summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lib.c2
-rw-r--r--parser.c2
-rw-r--r--parser.y2
-rw-r--r--stdlib/doc-syms.tl2
-rw-r--r--tests/010/tree.tl33
-rw-r--r--tree.c131
-rw-r--r--tree.h7
-rw-r--r--txr.1156
-rw-r--r--y.tab.c.shipped2
9 files changed, 309 insertions, 28 deletions
diff --git a/lib.c b/lib.c
index 1bcd9ffc..36b6186d 100644
--- a/lib.c
+++ b/lib.c
@@ -12814,7 +12814,7 @@ val sel(val seq, val where_in)
while (seq_get(&wh_iter, &wh)) {
val node = tree_lookup_node(seq, wh);
if (node)
- tree_insert(newtree, key(node));
+ tree_insert(newtree, key(node), t);
}
return newtree;
diff --git a/parser.c b/parser.c
index 060643b4..bca07741 100644
--- a/parser.c
+++ b/parser.c
@@ -444,7 +444,7 @@ tail:
while (nodes) {
val node = rcyc_pop(&nodes);
- tree_insert_node(obj, node);
+ tree_insert_node(obj, node, t);
}
} else {
while (nodes)
diff --git a/parser.y b/parser.y
index 7b09fd7b..4fe33092 100644
--- a/parser.y
+++ b/parser.y
@@ -956,7 +956,7 @@ tree : HASH_T list { if (parser->ignore)
val less_fn = fname_helper(parser, less_fn_name);
val equal_fn = fname_helper(parser, equal_fn_name);
val tr = tree(rest($2), key_fn,
- less_fn, equal_fn);
+ less_fn, equal_fn, t);
$$ = rl(tr, num($1)); } }
| HASH_T error { $$ = nil;
yybadtok(yychar, lit("tree node literal")); }
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 654a3610..80922b42 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -2002,8 +2002,10 @@
("tree-bind" "N-021A9008")
("tree-case" "N-03D834A5")
("tree-clear" "N-03C88274")
+ ("tree-count" "N-032882F2")
("tree-delete" "N-022035DF")
("tree-delete-node" "N-00772FAE")
+ ("tree-delete-specific-node" "N-009B02CA")
("tree-find" "N-0149BC05")
("tree-insert" "N-0114FF9E")
("tree-insert-node" "N-008B4AD9")
diff --git a/tests/010/tree.tl b/tests/010/tree.tl
index f5bfac42..898fd91d 100644
--- a/tests/010/tree.tl
+++ b/tests/010/tree.tl
@@ -183,3 +183,36 @@
(uni #T(() "a" "b") #T(() "b" "c")) ("a" "b" "c")
(diff #T(() "a" "b") #T(() "b" "c")) ("a")
(isec #T(() "a" "b") #T(() "b" "c")) ("b"))
+
+(defstruct (item label key) ()
+ label
+ key
+ (:method equal (it) it.key))
+
+(defun make-items ()
+ (vec (new (item 'a 1))
+ (new (item 'b 2))
+ (new (item 'c 2))
+ (new (item 'd 2))
+ (new (item 'e 2))
+ (new (item 'f 3))))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (each ((it items))
+ (vtest (tree-delete tr it) it))
+ (test tr #T(())))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (each ((it items))
+ (let* ((tn (tree-lookup-node tr it.key))
+ (iu (key tn)))
+ (vtest (tree-delete-specific-node tr tn) tn)
+ (each ((iv tr))
+ (test (eq iv.label iu.label) nil))))
+ (test tr #T(())))
+
+(let* ((items (make-items))
+ (tr (tree items : : : t)))
+ (vtest (vec-list [mapcar .label tr]) [mapcar .label items]))
diff --git a/tree.c b/tree.c
index 6adcdd7d..c3ddd756 100644
--- a/tree.c
+++ b/tree.c
@@ -360,7 +360,7 @@ static void tr_find_rebuild_scapegoat(val tree, struct tree *tr,
}
static void tr_insert(val tree, struct tree *tr, struct tree_iter *ti,
- val subtree, val node)
+ val subtree, val node, val dup)
{
val tn_key = if3(tr->key_fn,
funcall1(tr->key_fn, node->tn.key),
@@ -375,7 +375,7 @@ static void tr_insert(val tree, struct tree *tr, struct tree_iter *ti,
{
if (subtree->tn.left) {
set(mkloc(ti->path[ti->depth++], ti->self), subtree);
- tr_insert(tree, tr, ti, subtree->tn.left, node);
+ tr_insert(tree, tr, ti, subtree->tn.left, node, dup);
} else {
int dep = ti->depth + 1;
set(mkloc(subtree->tn.left, subtree), node);
@@ -386,7 +386,9 @@ static void tr_insert(val tree, struct tree *tr, struct tree_iter *ti,
}
} else if (if3(tr->equal_fn == nil,
equal(tn_key, tr_key),
- funcall2(tr->equal_fn, tn_key, tr_key))) {
+ funcall2(tr->equal_fn, tn_key, tr_key)) &&
+ !dup)
+ {
set(mkloc(node->tn.left, node), subtree->tn.left);
set(mkloc(node->tn.right, node), subtree->tn.right);
if (ti->depth > 0) {
@@ -402,7 +404,7 @@ static void tr_insert(val tree, struct tree *tr, struct tree_iter *ti,
} else {
if (subtree->tn.right) {
set(mkloc(ti->path[ti->depth++], ti->self), subtree);
- tr_insert(tree, tr, ti, subtree->tn.right, node);
+ tr_insert(tree, tr, ti, subtree->tn.right, node, dup);
} else {
int dep = ti->depth + 1;
set(mkloc(subtree->tn.right, subtree), node);
@@ -483,6 +485,79 @@ static val tr_do_delete(val tree, struct tree *tr, val subtree,
}
}
+static val tr_do_delete_specific(val tree, struct tree *tr, val subtree,
+ val parent, val key, val thisnode)
+{
+ if (subtree == nil) {
+ return nil;
+ } else if (subtree == thisnode) {
+ val le = subtree->tn.left;
+ val ri = subtree->tn.right;
+
+ if (le && ri) {
+ struct tree_iter trit = tree_iter_init(0);
+ val succ = tn_find_next(ri, &trit);
+ val succ_par = if3(trit.depth, trit.path[trit.depth - 1], subtree);
+
+ if (succ_par == subtree)
+ set(mkloc(succ_par->tn.right, succ_par), succ->tn.right);
+ else
+ set(mkloc(succ_par->tn.left, succ_par), succ->tn.right);
+
+ set(mkloc(succ->tn.left, succ), subtree->tn.left);
+ set(mkloc(succ->tn.right, succ), subtree->tn.right);
+
+ if (parent) {
+ if (parent->tn.left == subtree)
+ set(mkloc(parent->tn.left, parent), succ);
+ else
+ set(mkloc(parent->tn.right, parent), succ);
+ } else {
+ tr->root = succ;
+ }
+ } else {
+ uses_or2;
+ val chld = or2(le, ri);
+
+ if (parent) {
+ if (parent->tn.left == subtree)
+ set(mkloc(parent->tn.left, parent), chld);
+ else
+ set(mkloc(parent->tn.right, parent), chld);
+ } else {
+ set(mkloc(tr->root, tree), chld);
+ }
+ }
+
+ subtree->tn.left = subtree->tn.right = nil;
+ return subtree;
+ }
+
+ val tr_key = if3(tr->key_fn,
+ funcall1(tr->key_fn, subtree->tn.key),
+ subtree->tn.key);
+
+ if (if3(tr->less_fn,
+ funcall2(tr->less_fn, key, tr_key),
+ less(key, tr_key)))
+ {
+ val le = subtree->tn.left;
+ return tr_do_delete_specific(tree, tr, le, subtree, key, thisnode);
+ } else if (if3(tr->equal_fn == nil,
+ equal(key, tr_key),
+ funcall2(tr->equal_fn, key, tr_key)))
+ {
+ uses_or2;
+ val le = subtree->tn.left;
+ val ri = subtree->tn.right;
+ return or2(tr_do_delete_specific(tree, tr, le, subtree, key, thisnode),
+ tr_do_delete_specific(tree, tr, ri, subtree, key, thisnode));
+ } else {
+ val ri = subtree->tn.right;
+ return tr_do_delete_specific(tree, tr, ri, subtree, key, thisnode);
+ }
+}
+
static val tr_delete(val tree, struct tree *tr, val key)
{
if (tr->root) {
@@ -499,10 +574,28 @@ static val tr_delete(val tree, struct tree *tr, val key)
return nil;
}
-val tree_insert_node(val tree, val node)
+static val tr_delete_specific(val tree, struct tree *tr, val thisnode)
+{
+ if (tr->root) {
+ val node = tr_do_delete_specific(tree, tr, tr->root,
+ nil, key(thisnode), thisnode);
+ if (node) {
+ if (2 * --tr->size < tr->max_size) {
+ tr_rebuild(tree, tr, tr->root, nil, tr->size);
+ tr->max_size = tr->size;
+ }
+ }
+ return node;
+ }
+
+ return nil;
+}
+
+val tree_insert_node(val tree, val node, val dup_in)
{
val self = lit("tree-insert-node");
struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
+ val dup = default_null_arg(dup_in);
type_check(self, node, TNOD);
@@ -517,15 +610,15 @@ val tree_insert_node(val tree, val node)
struct tree_iter ti = tree_iter_init(0);
if (++tr->size > tr->max_size)
tr->max_size = tr->size;
- tr_insert(tree, tr, &ti, tr->root, node);
+ tr_insert(tree, tr, &ti, tr->root, node, dup);
}
return node;
}
-val tree_insert(val tree, val key)
+val tree_insert(val tree, val key, val dup_in)
{
- return tree_insert_node(tree, tnode(key, nil, nil));
+ return tree_insert_node(tree, tnode(key, nil, nil), default_null_arg(dup_in));
}
val tree_lookup_node(val tree, val key)
@@ -554,6 +647,14 @@ val tree_delete(val tree, val key)
return if2(node, node->tn.key);
}
+val tree_delete_specific_node(val tree, val node)
+{
+ val self = lit("tree-delete-node");
+ struct tree *tr = coerce(struct tree *, cobj_handle(self, tree, tree_cls));
+ return tr_delete_specific(tree, tr, node);
+}
+
+
static val tree_root(val tree)
{
val self = lit("tree-root");
@@ -680,11 +781,12 @@ static struct cobj_ops tree_ops = cobj_ops_init(tree_equal_op,
tree_mark,
tree_hash_op);
-val tree(val keys_in, val key_fn, val less_fn, val equal_fn)
+val tree(val keys_in, val key_fn, val less_fn, val equal_fn, val dup_in)
{
struct tree *tr = coerce(struct tree *, chk_calloc(1, sizeof *tr));
val keys = default_null_arg(keys_in), key;
val tree = cobj(coerce(mem_t *, tr), tree_cls, &tree_ops);
+ val dup = default_null_arg(dup_in);
seq_iter_t ki;
uses_or2;
@@ -702,7 +804,7 @@ val tree(val keys_in, val key_fn, val less_fn, val equal_fn)
seq_iter_init(tree_s, &ki, keys);
while (seq_get(&ki, &key))
- tree_insert(tree, key);
+ tree_insert(tree, key, dup);
return tree;
}
@@ -728,7 +830,7 @@ static val tree_construct(val opts, val keys)
val key_fn = tree_construct_fname(pop(&opts));
val less_fn = tree_construct_fname(pop(&opts));
val equal_fn = tree_construct_fname(pop(&opts));
- return tree(keys, key_fn, less_fn, equal_fn);
+ return tree(keys, key_fn, less_fn, equal_fn, t);
}
static val deep_copy_tnode(val node)
@@ -993,18 +1095,19 @@ void tree_init(void)
reg_fun(intern(lit("set-key"), user_package), func_n2(set_key));
reg_fun(intern(lit("copy-tnode"), user_package), func_n1(copy_tnode));
reg_fun(intern(lit("tnodep"), user_package), func_n1(tnodep));
- reg_fun(tree_s, func_n4o(tree, 0));
+ reg_fun(tree_s, func_n5o(tree, 0));
reg_fun(tree_construct_s, func_n2(tree_construct));
reg_fun(intern(lit("copy-search-tree"), user_package), func_n1(copy_search_tree));
reg_fun(intern(lit("make-similar-tree"), user_package), func_n1(make_similar_tree));
reg_fun(intern(lit("treep"), user_package), func_n1(treep));
reg_fun(intern(lit("tree-count"), user_package), func_n1(tree_count));
- reg_fun(intern(lit("tree-insert-node"), user_package), func_n2(tree_insert_node));
- reg_fun(intern(lit("tree-insert"), user_package), func_n2(tree_insert));
+ reg_fun(intern(lit("tree-insert-node"), user_package), func_n3o(tree_insert_node, 2));
+ reg_fun(intern(lit("tree-insert"), user_package), func_n3o(tree_insert, 2));
reg_fun(intern(lit("tree-lookup-node"), user_package), func_n2(tree_lookup_node));
reg_fun(intern(lit("tree-lookup"), user_package), func_n2(tree_lookup));
reg_fun(intern(lit("tree-delete-node"), user_package), func_n2(tree_delete_node));
reg_fun(intern(lit("tree-delete"), user_package), func_n2(tree_delete));
+ reg_fun(intern(lit("tree-delete-specific-node"), user_package), func_n2(tree_delete_specific_node));
reg_fun(intern(lit("tree-root"), user_package), func_n1(tree_root));
reg_fun(intern(lit("tree-begin"), user_package), func_n3o(tree_begin, 1));
reg_fun(intern(lit("copy-tree-iter"), user_package), func_n1(copy_tree_iter));
diff --git a/tree.h b/tree.h
index b0b85801..ad1b2327 100644
--- a/tree.h
+++ b/tree.h
@@ -40,17 +40,18 @@ val set_left(val node, val nleft);
val set_right(val node, val nright);
val set_key(val node, val nkey);
val copy_tnode(val node);
-val tree(val keys, val key_fn, val less_fn, val equal_fn);
+val tree(val keys, val key_fn, val less_fn, val equal_fn, val dup);
val copy_search_tree(val tree);
val make_similar_tree(val tree);
val treep(val obj);
val tree_count(val tree);
-val tree_insert_node(val tree, val node);
-val tree_insert(val tree, val key);
+val tree_insert_node(val tree, val node, val dup);
+val tree_insert(val tree, val key, val dup);
val tree_lookup_node(val tree, val key);
val tree_lookup(val tree, val key);
val tree_delete_node(val tree, val key);
val tree_delete(val tree, val key);
+val tree_delete_specific_node(val tree, val node);
val tree_begin(val tree, val lowkey, val highkey);
val copy_tree_iter(val iter);
val replace_tree_iter(val diter, val siter);
diff --git a/txr.1 b/txr.1
index 990b9522..4c650f0d 100644
--- a/txr.1
+++ b/txr.1
@@ -12498,6 +12498,12 @@ syntax, either explicitly or as defaults. Then, every
object is constructed from its respective literal syntax and inserted into
the tree.
+Duplicate objects are preserved. For instance the tree literal
+.code "#T(() 1 1 1)"
+specifies a tree with three nodes which have the same key.
+Duplicates appear in the tree in the order that they appear in the
+literal.
+
.NP* JSON Literals
.meIP >> #J json-syntax
Introduces a JSON literal.
@@ -53898,6 +53904,26 @@ objects as arguments or return
.code tnode
objects.
+Trees may store duplicate elements. The
+.code #T
+literal syntax may freely specify duplicate elements.
+The
+.code tree
+constructor function specifies an initial sequence of elements to
+be populated into the newly constructed tree. If this initial
+sequence contains duplicate elements, they are preserved if the optional
+.meta allow-dupes
+argument is true, otherwise only the rightmost member of any duplicate
+group appears in the tree.
+
+The insertion functions
+.code tree-insert
+and
+.code tree-insert-node
+also overwrite duplicates by default, but optionally allow them.
+Duplicates are ordered by insertion: most recently inserted duplicate
+is rightmost. However, tree lookup chooses an unspecified duplicate.
+
.coNP Function @ tnode
.synb
.mets (tnode < key < left << right )
@@ -54024,7 +54050,8 @@ fields are copied from
.coNP Function @ tree
.synb
-.mets (tree >> [ elems >> [ keyfun >> [ lessfun <> [ equalfun ]]]])
+.mets (tree >> [ elems
+.mets \ \ \ \ \ \ >> [ keyfun >> [ lessfun >> [ equalfun <> [ allow-dupes ]]]])
.syne
.desc
The
@@ -54069,6 +54096,44 @@ properties of an equivalence relation.
These three functions are collectively referred to as the tree's
.IR "key abstraction functions" .
+The
+.meta allow-dupes
+argument, which defaults to
+.codn nil ,
+is relevant if an
+.meta elems
+sequence is specified containing some elements which which appear to be
+duplicates, according to the tree object's
+.meta equalfun
+function. If
+.meta allow-dupes
+is true then duplicates are preserved: the tree will have as many nodes as
+there are elements in the
+.meta elems
+sequence. Moreover, the duplicates appear in the same relative order in
+the tree as they appear in the original
+.meta elems
+sequence.
+If
+.meta allow-dupes
+is false, then duplicates are suppressed: if any element appears more
+than once in
+.metn elements ,
+then only the last occurrence of that element appears in the tree.
+
+Note: the
+.code tree-insert
+and
+.code tree-insert-node
+functions also has an optional argument indicating whether an duplicate
+insertion replaces an existing element.
+
+Note: although the order of duplicate elements is preserved, when the
+.code tree-lookup
+function is used look up an key which is duplicated, the element
+which is retrieved is unspecified, and can change when the tree is
+reorganized due to insertions and deletions.
+
.coNP Function @ treep
.synb
.mets (treep << value )
@@ -54097,7 +54162,7 @@ which must be a search tree object.
.coNP Function @ tree-insert-node
.synb
-.mets (tree-insert-node < tree << node )
+.mets (tree-insert-node < tree < node <> [ allow-dupe ])
.syne
.desc
The
@@ -54140,11 +54205,30 @@ fields of
are overwritten as required by the semantics of the insertion operation.
Their original values are ignored.
-If
-.meta tree
-already contains node with with a matching key, then
+The
+.meta allow-dupe
+argument, defaulting to
+.codn nil ,
+is concerned with what happens if the tree already contains one or more
+nodes having a key equal to the
+.metn node 's
+key.
+.meta allow-dupe
+is false, then
.meta node
-replaces that node; that node is deleted from the tree.
+replaces an unspecified one of those existing nodes: that replaced node is
+deleted from the tree. Key equivalence is determined using tree's equality
+function (see the
+.meta equalfun
+argument of the
+.code tree
+function).
+If
+.meta allow-dupe
+is true, then the new node is inserted without replacing any node, and
+appears together with the existing duplicate or duplicates. Among
+the duplicates, the newly inserted node is the rightmost node in the
+tree order.
The
.code tree-insert-node
@@ -54154,7 +54238,7 @@ argument.
.coNP Function @ tree-insert
.synb
-.mets (tree-insert < tree << elem )
+.mets (tree-insert < tree < elem <> [ allow-dupe ])
.syne
.desc
The
@@ -54189,6 +54273,17 @@ as if by using the
.code tree-insert-node
function.
+If one or more elements equal to
+.meta elem
+already exist in the tree, then the behavior is determined by the
+.meta allow-dupe
+argument, which defaults to
+.codn nil .
+The semantics of
+.meta allow-dupe
+is as given in the description of
+.codn tree-insert-node .
+
The
.code tree-insert
function returns the newly inserted
@@ -54239,6 +54334,9 @@ If no such element is found, then
returns
.codn nil .
+If multiple nodes exist in the tree which have a matching key,
+it is unspecified which one of those nodes is retrieved.
+
.coNP Function @ tree-lookup
.synb
.mets (tree-lookup < tree << key )
@@ -54267,6 +54365,10 @@ A possible implementation is this:
(key node)))
.brev
+If the tree contains multiple elements which match
+.metn key ,
+it is unspecified which element is retrieved.
+
.coNP Function @ tree-delete-node
.synb
.mets (tree-delete-node < tree << key )
@@ -54297,6 +54399,12 @@ Otherwise, if a matching element is not found, then
.code nil
is returned.
+If more than one element exists inside
+.meta tree
+which matches
+.metn key ,
+it is unspecified which node is deleted and returned.
+
.coNP Function @ tree-delete
.synb
.mets (tree-delete < tree << key )
@@ -54312,6 +54420,12 @@ the element which matches
If successful, it returns that element, otherwise it returns
.codn nil .
+If more than one element exists inside
+.meta tree
+which matches
+.metn key ,
+it is unspecified which one is deleted.
+
Note: the semantics of the
.code tree-delete
function can be understood in terms of
@@ -54324,6 +54438,34 @@ A possible implementation is this:
(key node)))
.brev
+.coNP Function @ tree-delete-specific-node
+.synb
+.mets (tree-delete-specific-node < tree << node )
+.syne
+.desc
+The
+.code tree-delete-specific-node
+function searches
+.meta tree
+to find the specific node given by the
+.meta node
+argument. If
+.meta node
+is inserted into the tree, then it is deleted, and returned.
+
+If
+.meta node
+is not found in the tree, then the tree is unchanged, and
+.code nil
+is returned.
+
+Note: the search for
+.meta node
+is informed by
+.metn node 's
+key, for efficiency. However, if the tree contains duplicates of that key, then
+a linear search takes place among the duplicates.
+
.coNP Function @ tree-root
.synb
.mets (tree-root << tree )
diff --git a/y.tab.c.shipped b/y.tab.c.shipped
index 2dd3c380..8051a192 100644
--- a/y.tab.c.shipped
+++ b/y.tab.c.shipped
@@ -5047,7 +5047,7 @@ yyreduce:
val less_fn = fname_helper(parser, less_fn_name);
val equal_fn = fname_helper(parser, equal_fn_name);
val tr = tree(rest((yyvsp[(2) - (2)].val)), key_fn,
- less_fn, equal_fn);
+ less_fn, equal_fn, t);
(yyval.val) = rl(tr, num((yyvsp[(1) - (2)].lineno))); } }
break;