Merge git://factorcode.org/git/factor
commit
82c76fbf04
|
@ -139,7 +139,8 @@ TUPLE: no-method object generic ;
|
||||||
|
|
||||||
M: standard-combination perform-combination
|
M: standard-combination perform-combination
|
||||||
standard-combination-# (dispatch#) [
|
standard-combination-# (dispatch#) [
|
||||||
standard-methods single-combination
|
[ standard-methods ] keep "inline" word-prop
|
||||||
|
[ small-generic ] [ single-combination ] if
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
: default-hook-method ( word -- pair )
|
: default-hook-method ( word -- pair )
|
||||||
|
|
|
@ -6,10 +6,10 @@ IN: trees.avl
|
||||||
|
|
||||||
TUPLE: avl ;
|
TUPLE: avl ;
|
||||||
|
|
||||||
INSTANCE: avl assoc
|
INSTANCE: avl tree-mixin
|
||||||
|
|
||||||
: <avl> ( -- tree )
|
: <avl> ( -- tree )
|
||||||
avl construct-empty <tree> over set-delegate ;
|
avl construct-tree ;
|
||||||
|
|
||||||
TUPLE: avl-node balance ;
|
TUPLE: avl-node balance ;
|
||||||
|
|
||||||
|
@ -148,11 +148,3 @@ M: avl assoc-like
|
||||||
\ } [ >avl ] parse-literal ; parsing
|
\ } [ >avl ] parse-literal ; parsing
|
||||||
|
|
||||||
M: avl pprint-delims drop \ AVL{ \ } ;
|
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 ;
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
! Copyright (c) 2005 Mackenzie Straight.
|
! 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
|
USING: arrays kernel math namespaces sequences assocs parser
|
||||||
prettyprint.backend trees generic ;
|
prettyprint.backend trees generic ;
|
||||||
IN: trees.splay
|
IN: trees.splay
|
||||||
|
@ -7,10 +7,9 @@ IN: trees.splay
|
||||||
TUPLE: splay ;
|
TUPLE: splay ;
|
||||||
|
|
||||||
: <splay> ( -- splay-tree )
|
: <splay> ( -- splay-tree )
|
||||||
\ splay construct-empty
|
splay construct-tree ;
|
||||||
<tree> over set-delegate ;
|
|
||||||
|
|
||||||
INSTANCE: splay assoc
|
INSTANCE: splay tree-mixin
|
||||||
|
|
||||||
: rotate-right ( node -- node )
|
: rotate-right ( node -- node )
|
||||||
dup node-left
|
dup node-left
|
||||||
|
@ -138,16 +137,6 @@ M: splay new-assoc
|
||||||
\ } [ >splay ] parse-literal ; parsing
|
\ } [ >splay ] parse-literal ; parsing
|
||||||
|
|
||||||
M: splay assoc-like
|
M: splay assoc-like
|
||||||
drop dup splay? [
|
drop dup splay? [ >splay ] unless ;
|
||||||
dup tree? [ <splay> tuck set-delegate ] [ >splay ] if
|
|
||||||
] unless ;
|
|
||||||
|
|
||||||
M: splay pprint-delims drop \ SPLAY{ \ } ;
|
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 ;
|
|
||||||
|
|
|
@ -5,11 +5,19 @@ prettyprint.private kernel.private assocs random combinators
|
||||||
parser prettyprint.backend ;
|
parser prettyprint.backend ;
|
||||||
IN: trees
|
IN: trees
|
||||||
|
|
||||||
|
MIXIN: tree-mixin
|
||||||
|
|
||||||
TUPLE: tree root count ;
|
TUPLE: tree root count ;
|
||||||
|
|
||||||
: <tree> ( -- tree )
|
: <tree> ( -- tree )
|
||||||
f 0 tree construct-boa ;
|
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 ;
|
TUPLE: node key value left right ;
|
||||||
: <node> ( key value -- node )
|
: <node> ( key value -- node )
|
||||||
|
@ -111,16 +119,13 @@ M: tree set-at ( value key tree -- )
|
||||||
{ [ t ] [ >r node-right r> find-node ] }
|
{ [ t ] [ >r node-right r> find-node ] }
|
||||||
} cond ; inline
|
} 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 ;
|
>r tree-root r> find-node ;
|
||||||
|
|
||||||
M: tree clear-assoc
|
M: tree-mixin clear-assoc
|
||||||
0 over set-tree-count
|
0 over set-tree-count
|
||||||
f swap set-tree-root ;
|
f swap set-tree-root ;
|
||||||
|
|
||||||
M: tree assoc-size
|
|
||||||
tree-count ;
|
|
||||||
|
|
||||||
: copy-node-contents ( new old -- )
|
: copy-node-contents ( new old -- )
|
||||||
dup node-key pick set-node-key node-value swap set-node-value ;
|
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 )
|
: >tree ( assoc -- tree )
|
||||||
T{ tree f f 0 } assoc-clone-like ;
|
T{ tree f f 0 } assoc-clone-like ;
|
||||||
|
|
||||||
GENERIC: tree-assoc-like ( assoc -- tree )
|
M: tree-mixin assoc-like drop dup tree? [ >tree ] unless ;
|
||||||
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 ;
|
|
||||||
|
|
||||||
: TREE{
|
: TREE{
|
||||||
\ } [ >tree ] parse-literal ; parsing
|
\ } [ >tree ] parse-literal ; parsing
|
||||||
|
|
||||||
M: tree pprint-delims drop \ TREE{ \ } ;
|
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 ;
|
||||||
|
|
Loading…
Reference in New Issue