basis/boxes/boxes.factor

   1 ! Copyright (C) 2008, 2010 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 ; inline\r
  15 \r
  16 ERROR: box-empty box ;\r
  17 \r
  18 : check-box ( box -- box )\r
  19     dup occupied>> [ box-empty ] unless ; inline\r
  20 \r
  21 <PRIVATE\r
  22 \r
  23 : box-unsafe> ( box -- value )\r
  24     [ f ] change-value f >>occupied drop ; inline\r
  25 \r
  26 PRIVATE>\r
  27 \r
  28 : box> ( box -- value )\r
  29     check-box box-unsafe> ; inline\r
  30 \r
  31 : ?box ( box -- value/f ? )\r
  32     dup occupied>> [ box-unsafe> t ] [ drop f f ] if ; inline\r
  33 \r
  34 : if-box? ( box quot -- )\r
  35     [ ?box ] dip [ drop ] if ; inline\r