diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 851a58ecd6..6cc7f7f3e8 100755 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -139,7 +139,8 @@ TUPLE: no-method object generic ; M: standard-combination perform-combination standard-combination-# (dispatch#) [ - standard-methods single-combination + [ standard-methods ] keep "inline" word-prop + [ small-generic ] [ single-combination ] if ] with-variable ; : default-hook-method ( word -- pair ) diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index 0c4bf5af28..a806dafdec 100644 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -6,10 +6,10 @@ IN: trees.avl TUPLE: avl ; -INSTANCE: avl assoc +INSTANCE: avl tree-mixin : ( -- tree ) - avl construct-empty 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 ; diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor index 5f7c50cfb2..4fe6fe79a5 100644 --- a/extra/trees/splay/splay.factor +++ b/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-tree ) - \ splay construct-empty - 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? [ 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 ; diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index 971c961cbc..6d53d9e541 100644 --- a/extra/trees/trees.factor +++ b/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 ) f 0 tree construct-boa ; -INSTANCE: tree assoc +: construct-tree ( class -- tree ) + construct-empty over set-delegate ; inline + +INSTANCE: tree tree-mixin + +INSTANCE: tree-mixin assoc TUPLE: node key value left right ; : ( 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 ;