Clean up trees a bit

extra/trees/avl/avl.factor

@@ -6,10 +6,10 @@ IN: trees.avl
 
 TUPLE: avl ;
 
-INSTANCE: avl assoc
+INSTANCE: avl tree-mixin
 
 : <avl> ( -- tree )
-    avl construct-empty <tree> over set-delegate ;
+    avl construct-tree ;
 
 TUPLE: avl-node balance ;
 
@@ -148,11 +148,3 @@ M: avl assoc-like
     \ } [ >avl ] parse-literal ; parsing
 
 M: avl pprint-delims drop \ AVL{ \ } ;
-
-! When tuple inheritance is used, the following lines won't be necessary
-M: avl assoc-size tree-count ;
-M: avl clear-assoc delegate clear-assoc ;
-M: avl assoc-find >r tree-root r> find-node ;
-M: avl clone dup assoc-clone-like ;
-M: avl >pprint-sequence >alist ;
-M: avl pprint-narrow? drop t ;

extra/trees/splay/splay.factor

@@ -1,5 +1,5 @@
 ! Copyright (c) 2005 Mackenzie Straight.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces sequences assocs parser
 prettyprint.backend trees generic ;
 IN: trees.splay
@@ -7,10 +7,9 @@ IN: trees.splay
 TUPLE: splay ;
 
 : <splay> ( -- splay-tree )
-    \ splay construct-empty
-    <tree> over set-delegate ;
+    splay construct-tree ;
 
-INSTANCE: splay assoc
+INSTANCE: splay tree-mixin
 
 : rotate-right ( node -- node )
     dup node-left
@@ -138,16 +137,6 @@ M: splay new-assoc
     \ } [ >splay ] parse-literal ; parsing
 
 M: splay assoc-like
-    drop dup splay? [
-        dup tree? [ <splay> tuck set-delegate ] [ >splay ] if
-    ] unless ;
+    drop dup splay? [ >splay ] unless ;
 
 M: splay pprint-delims drop \ SPLAY{ \ } ;
-
-! When tuple inheritance is used, the following lines won't be necessary
-M: splay assoc-size tree-count ;
-M: splay clear-assoc delegate clear-assoc ;
-M: splay assoc-find >r tree-root r> find-node ;
-M: splay clone dup assoc-clone-like ;
-M: splay >pprint-sequence >alist ;
-M: splay pprint-narrow? drop t ;

extra/trees/trees.factor

@@ -5,11 +5,19 @@ prettyprint.private kernel.private assocs random combinators
 parser prettyprint.backend ;
 IN: trees
 
+MIXIN: tree-mixin
+
 TUPLE: tree root count ;
+
 : <tree> ( -- tree )
     f 0 tree construct-boa ;
 
-INSTANCE: tree assoc
+: construct-tree ( class -- tree )
+    construct-empty <tree> over set-delegate ; inline
+
+INSTANCE: tree tree-mixin
+
+INSTANCE: tree-mixin assoc
 
 TUPLE: node key value left right ;
 : <node> ( key value -- node )
@@ -111,16 +119,13 @@ M: tree set-at ( value key tree -- )
         { [ t ] [ >r node-right r> find-node ] }
     } cond ; inline
 
-M: tree assoc-find ( tree quot -- key value ? )
+M: tree-mixin assoc-find ( tree quot -- key value ? )
     >r tree-root r> find-node ;
 
-M: tree clear-assoc
+M: tree-mixin clear-assoc
     0 over set-tree-count
     f swap set-tree-root ;
 
-M: tree assoc-size
-    tree-count ;
-
 : copy-node-contents ( new old -- )
     dup node-key pick set-node-key node-value swap set-node-value ;
 
@@ -189,16 +194,14 @@ M: tree clone dup assoc-clone-like ;
 : >tree ( assoc -- tree )
     T{ tree f f 0 } assoc-clone-like ;
 
-GENERIC: tree-assoc-like ( assoc -- tree )
-M: tuple tree-assoc-like ! will need changes for tuple inheritance
-    dup delegate dup tree? [ nip ] [ drop >tree ] if ;
-M: tree tree-assoc-like ;
-M: assoc tree-assoc-like >tree ;
-M: tree assoc-like drop tree-assoc-like ;
+M: tree-mixin assoc-like drop dup tree? [ >tree ] unless ;
 
 : TREE{
     \ } [ >tree ] parse-literal ; parsing
 
 M: tree pprint-delims drop \ TREE{ \ } ;
-M: tree >pprint-sequence >alist ;
-M: tree pprint-narrow? drop t ;
+
+M: tree-mixin assoc-size tree-count ;
+M: tree-mixin clone dup assoc-clone-like ;
+M: tree-mixin >pprint-sequence >alist ;
+M: tree-mixin pprint-narrow? drop t ;