2005-01-29 14:18:28 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2004-12-10 19:29:07 -05:00
|
|
|
IN: kernel
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-03-21 15:13:40 -05:00
|
|
|
: slip ( quot x -- x | quot: -- )
|
2004-11-16 12:35:19 -05:00
|
|
|
>r call r> ; inline
|
2004-09-24 23:22:44 -04:00
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: keep ( x quot -- x | quot: x -- )
|
2004-11-27 00:33:17 -05:00
|
|
|
over >r call r> ; inline
|
2004-08-22 16:04:55 -04:00
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: 2keep ( x y quot -- x y | quot: x y -- )
|
2004-11-27 00:33:17 -05:00
|
|
|
over >r pick >r call r> r> ; inline
|
2004-11-08 22:36:51 -05:00
|
|
|
|
2005-02-24 20:52:17 -05:00
|
|
|
: while ( quot generator -- )
|
|
|
|
#! Keep applying the quotation to the value produced by
|
|
|
|
#! calling the generator until the generator returns f.
|
|
|
|
2dup >r >r swap >r call dup [
|
|
|
|
r> call r> r> while
|
|
|
|
] [
|
|
|
|
r> 2drop r> r> 2drop
|
|
|
|
] ifte ; inline
|
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: ifte* ( cond true false -- | true: cond -- | false: -- )
|
2005-03-21 15:13:40 -05:00
|
|
|
#! [ X ] [ Y ] ifte* ==> dup [ X ] [ drop Y ] ifte
|
2005-01-19 21:01:47 -05:00
|
|
|
pick [ drop call ] [ 2nip call ] ifte ; inline
|
2004-08-24 15:27:37 -04:00
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
: ?ifte ( default cond true false -- )
|
2005-03-21 15:13:40 -05:00
|
|
|
#! [ X ] [ Y ] ?ifte ==> dup [ nip X ] [ drop Y ] ifte
|
2005-01-14 12:01:48 -05:00
|
|
|
>r >r dup [
|
|
|
|
nip r> r> drop call
|
|
|
|
] [
|
|
|
|
drop r> drop r> call
|
|
|
|
] ifte ; inline
|
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: unless ( cond quot -- | quot: -- )
|
2004-07-16 02:26:21 -04:00
|
|
|
#! Execute a quotation only when the condition is f. The
|
|
|
|
#! condition is popped off the stack.
|
2004-11-16 12:35:19 -05:00
|
|
|
[ ] swap ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: unless* ( cond quot -- | quot: -- )
|
2004-07-16 02:26:21 -04:00
|
|
|
#! If cond is f, pop it off the stack and evaluate the
|
|
|
|
#! quotation. Otherwise, leave cond on the stack.
|
2004-11-16 12:35:19 -05:00
|
|
|
over [ drop ] [ nip call ] ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: when ( cond quot -- | quot: -- )
|
2004-07-16 02:26:21 -04:00
|
|
|
#! Execute a quotation only when the condition is not f. The
|
|
|
|
#! condition is popped off the stack.
|
2004-11-16 12:35:19 -05:00
|
|
|
[ ] ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-22 00:22:36 -04:00
|
|
|
: when* ( cond quot -- | quot: cond -- )
|
2004-07-16 02:26:21 -04:00
|
|
|
#! If the condition is true, it is left on the stack, and
|
|
|
|
#! the quotation is evaluated. Otherwise, the condition is
|
|
|
|
#! popped off the stack.
|
2004-11-26 22:23:57 -05:00
|
|
|
dupd [ drop ] ifte ; inline
|