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
8 ! Withhold: FICA, Medicare, Federal (FICA is social security)
10 TUPLE: tax-table entity single married ;
11 C: <tax-table> tax-table
13 GENERIC: adjust-allowances* ( salary w4 tax-table entity -- newsalary )
14 GENERIC: withholding* ( salary w4 tax-table entity -- x )
16 : adjust-allowances ( salary w4 tax-table -- newsalary )
17 dup entity>> adjust-allowances* ;
19 : withholding ( salary w4 tax-table -- x )
20 dup entity>> federal = [
21 dup entity>> withholding*
23 [ dup entity>> withholding* ]
24 [ drop <federal> federal withholding* ] 3bi +
27 : tax-bracket-range ( pair -- n ) first2 swap - ;
29 : tax-bracket ( tax salary triples -- tax salary )
30 [ [ tax-bracket-range min ] keep third * + ] 2keep
31 tax-bracket-range [-] ;
33 : tax ( salary triples -- x )
34 0 -rot [ tax-bracket ] each drop ;
36 : marriage-table ( w4 tax-table -- triples )
38 [ married>> ] [ single>> ] if ;
40 : net ( salary w4 collector -- x )
41 >r dupd r> withholding - ;