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 : box> ( box -- value )\r
  22     check-box [ f ] change-value f >>occupied drop ; inline\r
  23 \r
  24 : ?box ( box -- value/f ? )\r
  25     dup occupied>> [ box> t ] [ drop f f ] if ; inline\r
  26 \r
  27 : if-box? ( box quot -- )\r
  28     [ ?box ] dip [ drop ] if ; inline\r