basis/boxes/boxes.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: kernel accessors ;\r
   4 IN: boxes\r
   5 \r
   6 TUPLE: box value occupied ;\r
   7 \r
   8 : <box> ( -- box ) box new ;\r
   9 \r
  10 ERROR: box-full box ;\r
  11 \r
  12 : >box ( value box -- )\r
  13     dup occupied>>\r
  14     [ box-full ] [ t >>occupied (>>value) ] if ;\r
  15 \r
  16 ERROR: box-empty box ;\r
  17 \r
  18 : box> ( box -- value )\r
  19     dup occupied>>\r
  20     [ [ f ] change-value f >>occupied drop ] [ box-empty ] if ;\r
  21 \r
  22 : ?box ( box -- value/f ? )\r
  23     dup occupied>> [ box> t ] [ drop f f ] if ;\r
  24 \r
  25 : if-box? ( box quot -- )\r
  26     [ ?box ] dip [ drop ] if ; inline\r