2006-01-06 02:04:42 -05:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
2005-07-16 22:16:18 -04:00
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: sequences
|
2005-08-14 02:08:11 -04:00
|
|
|
USING: generic kernel lists strings ;
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
G: tree-each* ( obj quot -- | quot: elt -- )
|
2005-08-22 15:33:18 -04:00
|
|
|
[ over ] standard-combination ; inline
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
: tree-each ( obj quot -- | quot: elt -- )
|
2006-01-10 23:44:17 -05:00
|
|
|
[ call ] 2keep tree-each* ; inline
|
2006-01-06 02:04:42 -05:00
|
|
|
|
2006-02-01 20:10:08 -05:00
|
|
|
: tree-each-with ( obj obj quot -- )
|
2005-07-16 22:16:18 -04:00
|
|
|
swap [ with ] tree-each 2drop ; inline
|
|
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
M: object tree-each* 2drop ;
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
M: sequence tree-each* swap [ swap tree-each ] each-with ;
|
2005-07-16 22:16:18 -04:00
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
M: string tree-each* 2drop ;
|
2005-08-14 02:08:11 -04:00
|
|
|
|
2006-01-06 02:04:42 -05:00
|
|
|
M: cons tree-each* ( cons quot -- )
|
2005-07-16 22:16:18 -04:00
|
|
|
>r uncons r> tuck >r >r tree-each r> r> tree-each ;
|
2006-01-06 02:04:42 -05:00
|
|
|
|
|
|
|
|
M: wrapper tree-each* ( wrapper quot -- )
|
|
|
|
|
>r wrapped r> tree-each ;
|
2006-02-01 20:10:08 -05:00
|
|
|
|
|
|
|
|
: tree-subset ( obj quot -- seq )
|
|
|
|
|
[ tree-each ] select ; inline
|
|
|
|
|
|
|
|
|
|
: tree-subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
|
|
|
|
|
swap [ with rot ] tree-subset 2nip ; inline
|