Merge git://factorcode.org/git/factor
commit
82c76fbf04
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue