diff options
-rw-r--r-- | lisplib.c | 1 | ||||
-rw-r--r-- | share/txr/stdlib/defset.tl | 9 | ||||
-rw-r--r-- | tree.c | 24 | ||||
-rw-r--r-- | tree.h | 3 | ||||
-rw-r--r-- | txr.1 | 62 |
5 files changed, 98 insertions, 1 deletions
@@ -792,6 +792,7 @@ static val defset_set_entries(val dlt, val fun) { val name[] = { lit("defset"), lit("sub-list"), lit("sub-vec"), lit("sub-str"), + lit("left"), lit("right"), lit("key"), nil }; set_dlt_entries(dlt, name, fun); diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl index 9920e925..f15afe4b 100644 --- a/share/txr/stdlib/defset.tl +++ b/share/txr/stdlib/defset.tl @@ -119,3 +119,12 @@ (defset sub-str (str : (from 0) (to t)) items ^(progn (replace-str ,str ,items ,from ,to) ,items)) + +(defset left (node) nleft + ^(progn (set-left ,node ,nleft) ,nleft)) + +(defset right (node) nright + ^(progn (set-right ,node ,nright) ,nright)) + +(defset key (node) nkey + ^(progn (set-key ,node ,nkey) ,nkey)) @@ -119,6 +119,27 @@ val key(val node) return node->tn.key; } +val set_left(val node, val nleft) +{ + type_check(lit("set-left"), node, TNOD); + node->tn.left = nleft; + return node; +} + +val set_right(val node, val nright) +{ + type_check(lit("set-right"), node, TNOD); + node->tn.right = nright; + return node; +} + +val set_key(val node, val nkey) +{ + type_check(lit("set-key"), node, TNOD); + node->tn.key = nkey; + return node; +} + val copy_tnode(val node) { val obj = (type_check(lit("copy-tnode"), node, TNOD), make_obj()); @@ -684,6 +705,9 @@ void tree_init(void) 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)); + reg_fun(intern(lit("set-left"), user_package), func_n2(set_left)); + reg_fun(intern(lit("set-right"), user_package), func_n2(set_right)); + 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(tree_s, func_n4o(tree, 0)); reg_fun(tree_construct_s, func_n2(tree_construct)); @@ -34,6 +34,9 @@ val tnodep(val obj); val left(val node); val right(val node); val key(val node); +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 treep(val obj); @@ -12804,6 +12804,9 @@ defined by \*(TX programs. .mets (sock-peer << socket ) .mets (carray-sub < carray >> [ from <> [ to ]]) .mets (sub-buf < buf >> [ from <> [ to ]]) +.mets (left << node ) +.mets (right << node ) +.mets (key << node ) .onom .NP* Built-In Place-Mutating Operators @@ -45215,11 +45218,15 @@ if is a tree node. Otherwise, it returns .codn nil . -.coNP Functions @, key @ left and @ right +.coNP Accessors @, key @ left and @ right .synb .mets (key << node ) .mets (left << node ) .mets (right << node ) +.mets (set (car << object ) << new-value ) +.mets (set (key << node ) << new-key ) +.mets (set (left << node ) << new-left ) +.mets (set (right << node ) << new-right ) .syne .desc The @@ -45232,6 +45239,59 @@ functions retrieve the corresponding fields of the object, which must be of type .codn tnode . +Forms based on the +.codn key , +.code left +and +.code right +symbol are defined as syntactic places. +Assigning a value +.code v +to +.code "(key n)" +using the +.code set +operator, as in +.codn "(set (key n) v)" , +is equivalent to +.code "(set-key n v)" +except that the value of the expression is +.code v +rather than +.codn n . +Similar statements hold true for +.code left +and +.code right +in relation to +.code set-left +and +.codn set-right . + +.coNP Functions @, set-key @ set-left and @ set-right +.synb +.mets (set-key < node << new-key ) +.mets (set-left < node << new-left ) +.mets (set-right < node << new-right ) +.syne +.desc +The +.codn set-key , +.code set-left +and +.code set-right +functions replace the corresponding fields of +.meta node +with new values. + +The +.meta node +argument must be of type +.codn tnode . + +These functions all return +.metn node . + .coNP Function @ copy-tnode .synb .mets (copy-tnode << node ) |