extra/taxes/usa/usa.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs kernel math math.intervals
   4 namespaces sequences money math.order taxes.usa.w4 ;
   5 IN: taxes.usa
   6
   7 ! Withhold: FICA, Medicare, Federal (FICA is social security)
   8
   9 TUPLE: tax-table entity single married ;
  10 C: <tax-table> tax-table
  11
  12 GENERIC: adjust-allowances* ( salary w4 tax-table entity -- newsalary )
  13 GENERIC: withholding* ( salary w4 tax-table entity -- x )
  14
  15 : adjust-allowances ( salary w4 tax-table -- newsalary )
  16     dup entity>> adjust-allowances* ;
  17
  18 : withholding ( salary w4 tax-table -- x )
  19     dup entity>> withholding* ;
  20
  21 : tax-bracket-range ( pair -- n ) first2 swap - ;
  22
  23 : tax-bracket ( tax salary triples -- tax salary )
  24     [ [ tax-bracket-range min ] keep third * + ] 2keep
  25     tax-bracket-range [-] ;
  26
  27 : tax ( salary triples -- x )
  28     0 -rot [ tax-bracket ] each drop ;
  29
  30 : marriage-table ( w4 tax-table -- triples )
  31     swap married?>>
  32     [ married>> ] [ single>> ] if ;