core/math/bitfields/bitfields.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math sequences words ;
   4 IN: math.bitfields
   5
   6 GENERIC: (bitfield) ( value accum shift -- newaccum )
   7
   8 M: integer (bitfield) ( value accum shift -- newaccum )
   9     swapd shift bitor ;
  10
  11 M: pair (bitfield) ( value accum pair -- newaccum )
  12     first2 >r dup word? [ swapd execute ] when r> shift bitor ;
  13
  14 : bitfield ( values... bitspec -- n )
  15     0 [ (bitfield) ] reduce ;
  16
  17 : flags ( values -- n )
  18     0 [ dup word? [ execute ] when bitor ] reduce ;