diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index c37448fc1f..264db53a9e 100755 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2007 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. USING: combinators kernel generic math math.functions -math.parser namespaces io prettyprint.backend sequences trees -assocs parser accessors math.order ; +math.parser namespaces io sequences trees +assocs parser accessors math.order prettyprint.custom ; IN: trees.avl TUPLE: avl < tree ; @@ -155,4 +155,4 @@ M: avl assoc-like : AVL{ \ } [ >avl ] parse-literal ; parsing -! M: avl pprint-delims drop \ AVL{ \ } ; +M: avl pprint-delims drop \ AVL{ \ } ; diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor index adcf0a2522..c47b6b5d07 100755 --- a/extra/trees/splay/splay.factor +++ b/extra/trees/splay/splay.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2005 Mackenzie Straight. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math namespaces sequences assocs parser -prettyprint.backend trees generic math.order accessors ; +trees generic math.order accessors prettyprint.custom ; IN: trees.splay TUPLE: splay < tree ; @@ -137,4 +137,4 @@ M: splay new-assoc M: splay assoc-like drop dup splay? [ >splay ] unless ; -! M: splay pprint-delims drop \ SPLAY{ \ } ; +M: splay pprint-delims drop \ SPLAY{ \ } ; diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index 892b3b3944..41a8a21c1d 100755 --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel generic math sequences arrays io namespaces prettyprint.private kernel.private assocs random combinators -parser prettyprint.backend math.order accessors deques make -prettyprint.custom ; +parser math.order accessors deques make prettyprint.custom ; IN: trees TUPLE: tree root count ; @@ -21,15 +20,17 @@ INSTANCE: tree assoc TUPLE: node key value left right ; : new-node ( key value class -- node ) - new swap >>value swap >>key ; + new + swap >>value + swap >>key ; : ( key value -- node ) node new-node ; SYMBOL: current-side -: left ( -- symbol ) -1 ; inline -: right ( -- symbol ) 1 ; inline +CONSTANT: left -1 +CONSTANT: right 1 : key-side ( k1 k2 -- n ) <=> { @@ -46,24 +47,33 @@ SYMBOL: current-side : node-link@ ( node ? -- node ) go-left? xor [ left>> ] [ right>> ] if ; + : set-node-link@ ( left parent ? -- ) go-left? xor [ (>>left) ] [ (>>right) ] if ; : node-link ( node -- child ) f node-link@ ; + : set-node-link ( child node -- ) f set-node-link@ ; + : node+link ( node -- child ) t node-link@ ; + : set-node+link ( child node -- ) t set-node-link@ ; -: with-side ( side quot -- ) [ swap current-side set call ] with-scope ; inline +: with-side ( side quot -- ) + [ swap current-side set call ] with-scope ; inline + : with-other-side ( quot -- ) current-side get neg swap with-side ; inline + : go-left ( quot -- ) left swap with-side ; inline + : go-right ( quot -- ) right swap with-side ; inline : leaf? ( node -- ? ) [ left>> ] [ right>> ] bi or not ; -: random-side ( -- side ) left right 2array random ; +: random-side ( -- side ) + left right 2array random ; : choose-branch ( key node -- key node-left/right ) 2dup key>> key-side [ node-link ] with-side ; @@ -192,6 +202,6 @@ M: tree assoc-like drop dup tree? [ >tree ] unless ; \ } [ >tree ] parse-literal ; parsing M: tree assoc-size count>> ; -! M: tree pprint-delims drop \ TREE{ \ } ; -! M: tree >pprint-sequence >alist ; -! M: tree pprint-narrow? drop t ; +M: tree pprint-delims drop \ TREE{ \ } ; +M: tree >pprint-sequence >alist ; +M: tree pprint-narrow? drop t ;