Merge git://factorcode.org/git/factor

db4
Doug Coleman 2008-01-17 12:55:07 -10:00
commit 82c76fbf04
4 changed files with 25 additions and 40 deletions

View File

@ -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 )

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;