diff options
| -rw-r--r-- | lib.c | 2 | ||||
| -rw-r--r-- | parser.c | 2 | ||||
| -rw-r--r-- | parser.y | 2 | ||||
| -rw-r--r-- | stdlib/doc-syms.tl | 2 | ||||
| -rw-r--r-- | tests/010/tree.tl | 33 | ||||
| -rw-r--r-- | tree.c | 131 | ||||
| -rw-r--r-- | tree.h | 7 | ||||
| -rw-r--r-- | txr.1 | 156 | ||||
| -rw-r--r-- | y.tab.c.shipped | 2 |
9 files changed, 309 insertions, 28 deletions
@@ -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; @@ -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) @@ -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])) @@ -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)); @@ -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); @@ -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; |