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
|
|
|
|
2004-09-24 23:22:44 -04:00
|
|
|
: slip ( quot x -- x )
|
2004-11-16 12:35:19 -05:00
|
|
|
>r call r> ; inline
|
2004-09-24 23:22:44 -04:00
|
|
|
|
|
|
|
: 2slip ( quot x y -- x y )
|
2004-11-16 12:35:19 -05:00
|
|
|
>r >r call r> r> ; inline
|
2004-09-24 23:22:44 -04:00
|
|
|
|
|
|
|
: 3slip ( quot x y z -- x y z )
|
2004-11-16 12:35:19 -05:00
|
|
|
>r >r >r call r> r> r> ; inline
|
2004-09-24 23:22:44 -04:00
|
|
|
|
2004-08-22 16:04:55 -04:00
|
|
|
: keep ( a quot -- a )
|
|
|
|
#! Execute the quotation with a on the stack, and restore a
|
|
|
|
#! after the quotation returns.
|
2004-11-27 00:33:17 -05:00
|
|
|
over >r call r> ; inline
|
2004-08-22 16:04:55 -04:00
|
|
|
|
2004-11-08 22:36:51 -05:00
|
|
|
: 2keep ( a b quot -- a b )
|
|
|
|
#! Execute the quotation with a and b on the stack, and
|
|
|
|
#! restore a and b after the quotation returns.
|
2004-11-27 00:33:17 -05:00
|
|
|
over >r pick >r call r> r> ; inline
|
2004-11-08 22:36:51 -05:00
|
|
|
|
2004-10-06 23:34:22 -04:00
|
|
|
: apply ( code input -- code output )
|
|
|
|
#! Apply code to input.
|
2004-11-27 00:33:17 -05:00
|
|
|
swap dup >r call r> swap ; inline
|
2004-10-06 23:34:22 -04:00
|
|
|
|
2004-08-24 15:27:37 -04:00
|
|
|
: ifte* ( cond true false -- )
|
|
|
|
#! If the condition is not f, execute the 'true' quotation,
|
|
|
|
#! with the condition on the stack. Otherwise, pop the
|
|
|
|
#! condition and execute the 'false' quotation.
|
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 -- )
|
|
|
|
#! If cond is true, drop default and apply true
|
|
|
|
#! quotation to cond. Otherwise, drop cond, and apply false
|
|
|
|
#! to default.
|
|
|
|
>r >r dup [
|
|
|
|
nip r> r> drop call
|
|
|
|
] [
|
|
|
|
drop r> drop r> call
|
|
|
|
] ifte ; inline
|
|
|
|
|
2004-08-31 00:27:09 -04:00
|
|
|
: unless ( cond 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.
|
|
|
|
#!
|
|
|
|
#! In order to compile, the quotation must consume as many
|
|
|
|
#! values as it produces.
|
2004-11-16 12:35:19 -05:00
|
|
|
[ ] swap ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-08-31 00:27:09 -04:00
|
|
|
: unless* ( cond 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.
|
|
|
|
#!
|
|
|
|
#! In order to compile, the quotation must consume one less
|
|
|
|
#! value than it produces.
|
2004-11-16 12:35:19 -05:00
|
|
|
over [ drop ] [ nip call ] ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
: ?unless ( default cond false -- )
|
|
|
|
#! If cond is true, drop default and leave cond on the
|
|
|
|
#! stack. Otherwise, drop default, and apply false
|
|
|
|
#! quotation to default.
|
|
|
|
>r dup [ nip r> drop ] [ drop r> call ] ifte ; inline
|
|
|
|
|
2004-08-31 00:27:09 -04:00
|
|
|
: when ( cond 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.
|
|
|
|
#!
|
|
|
|
#! In order to compile, the quotation must consume as many
|
|
|
|
#! values as it produces.
|
2004-11-16 12:35:19 -05:00
|
|
|
[ ] ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-08-31 00:27:09 -04:00
|
|
|
: when* ( cond quot -- )
|
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.
|
|
|
|
#!
|
|
|
|
#! In order to compile, the quotation must consume one more
|
|
|
|
#! value than it produces.
|
2004-11-26 22:23:57 -05:00
|
|
|
dupd [ drop ] ifte ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-01-02 23:57:54 -05:00
|
|
|
: ?when ( default cond true -- )
|
|
|
|
#! If cond is true, drop default and apply true
|
|
|
|
#! quotation to cond. Otherwise, drop cond, and leave
|
|
|
|
#! default on the stack.
|
|
|
|
>r dup [ nip r> call ] [ r> 2drop ] ifte ; inline
|
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
: forever ( quot -- )
|
|
|
|
#! The code is evaluated in an infinite loop. Typically, a
|
|
|
|
#! continuation is used to escape the infinite loop.
|
|
|
|
#!
|
|
|
|
#! This combinator will not compile.
|
|
|
|
dup slip forever ;
|