2008-02-19 15:38:02 -05:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-05-14 20:03:07 -04:00
|
|
|
USING: kernel accessors ;
|
2008-02-19 15:38:02 -05:00
|
|
|
IN: boxes
|
|
|
|
|
2008-05-15 01:03:21 -04:00
|
|
|
TUPLE: box value occupied ;
|
2008-02-19 15:38:02 -05:00
|
|
|
|
2008-04-13 16:06:09 -04:00
|
|
|
: <box> ( -- box ) box new ;
|
2008-02-19 15:38:02 -05:00
|
|
|
|
2008-05-14 20:03:07 -04:00
|
|
|
ERROR: box-full box ;
|
|
|
|
|
2008-02-19 15:38:02 -05:00
|
|
|
: >box ( value box -- )
|
2008-05-15 01:03:21 -04:00
|
|
|
dup occupied>>
|
|
|
|
[ box-full ] [ t >>occupied (>>value) ] if ;
|
2008-05-14 20:03:07 -04:00
|
|
|
|
|
|
|
ERROR: box-empty box ;
|
2008-02-19 15:38:02 -05:00
|
|
|
|
|
|
|
: box> ( box -- value )
|
2008-05-15 01:03:21 -04:00
|
|
|
dup occupied>>
|
|
|
|
[ [ f ] change-value f >>occupied drop ] [ box-empty ] if ;
|
2008-02-19 15:38:02 -05:00
|
|
|
|
|
|
|
: ?box ( box -- value/f ? )
|
2008-05-15 01:03:21 -04:00
|
|
|
dup occupied>> [ box> t ] [ drop f f ] if ;
|
2008-02-29 20:10:30 -05:00
|
|
|
|
|
|
|
: if-box? ( box quot -- )
|
2008-11-29 14:21:40 -05:00
|
|
|
[ ?box ] dip [ drop ] if ; inline
|