/extra/taxes/usa/usa.factor

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