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 combinators.lib money math.order ;
7 : monthly ( x -- y ) 12 / ;
8 : semimonthly ( x -- y ) 24 / ;
9 : biweekly ( x -- y ) 26 / ;
10 : weekly ( x -- y ) 52 / ;
11 : daily ( x -- y ) 360 / ;
13 ! Each employee fills out a w4
14 TUPLE: w4 year allowances married? ;
17 : allowance ( -- x ) 3500 ; inline
19 : calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ;
21 ! Withhold: FICA, Medicare, Federal (FICA is social security)
22 : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline
24 ! Base rate -- income over this rate is not taxed
25 ERROR: fica-base-unknown ;
26 : fica-base-rate ( year -- x )
30 } at* [ fica-base-unknown ] unless ;
32 : fica-tax ( salary w4 -- x )
33 year>> fica-base-rate min fica-tax-rate * ;
35 ! Employer tax only, not withheld
36 : futa-tax-rate ( -- x ) DECIMAL: .062 ; inline
37 : futa-base-rate ( -- x ) 7000 ; inline
38 : futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline
40 : futa-tax ( salary w4 -- x )
41 drop futa-base-rate min
42 futa-tax-rate futa-tax-offset-credit -
45 ! No base rate for medicare; all wages subject
46 : medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline
47 : medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ;
50 GENERIC: adjust-allowances ( salary w4 collector -- newsalary )
51 GENERIC: withholding ( salary w4 collector -- x )
53 TUPLE: tax-table single married ;
55 : <tax-table> ( single married class -- obj )
56 >r tax-table boa r> construct-delegate ;
58 : tax-bracket-range ( pair -- n ) dup second swap first - ;
60 : tax-bracket ( tax salary triples -- tax salary )
61 [ [ tax-bracket-range min ] keep third * + ] 2keep
62 tax-bracket-range [-] ;
64 : tax ( salary triples -- x )
65 0 -rot [ tax-bracket ] each drop ;
67 : marriage-table ( w4 tax-table -- triples )
68 swap married?>> [ married>> ] [ single>> ] if ;
70 : federal-tax ( salary w4 tax-table -- n )
71 [ adjust-allowances ] 2keep marriage-table tax ;
73 ! http://www.irs.gov/pub/irs-pdf/p15.pdf
74 ! Table 7 ANNUAL Payroll Period
76 : federal-single ( -- triples )
79 { 2650 10300 DECIMAL: .10 }
80 { 10300 33960 DECIMAL: .15 }
81 { 33960 79725 DECIMAL: .25 }
82 { 79725 166500 DECIMAL: .28 }
83 { 166500 359650 DECIMAL: .33 }
84 { 359650 1/0. DECIMAL: .35 }
87 : federal-married ( -- triples )
90 { 8000 23550 DECIMAL: .10 }
91 { 23550 72150 DECIMAL: .15 }
92 { 72150 137850 DECIMAL: .25 }
93 { 137850 207700 DECIMAL: .28 }
94 { 207700 365100 DECIMAL: .33 }
95 { 365100 1/0. DECIMAL: .35 }
99 INSTANCE: federal collector
100 : <federal> ( -- obj )
101 federal-single federal-married federal <tax-table> ;
103 M: federal adjust-allowances ( salary w4 collector -- newsalary )
104 drop calculate-w4-allowances - ;
106 M: federal withholding ( salary w4 tax-table -- x )
107 [ federal-tax ] 3keep drop
113 : minnesota-single ( -- triples )
115 { 0 1950 DECIMAL: 0 }
116 { 1950 23750 DECIMAL: .0535 }
117 { 23750 73540 DECIMAL: .0705 }
118 { 73540 1/0. DECIMAL: .0785 }
121 : minnesota-married ( -- triples )
123 { 0 7400 DECIMAL: 0 }
124 { 7400 39260 DECIMAL: .0535 }
125 { 39260 133980 DECIMAL: .0705 }
126 { 133980 1/0. DECIMAL: .0785 }
130 INSTANCE: minnesota collector
131 : <minnesota> ( -- obj )
132 minnesota-single minnesota-married minnesota <tax-table> ;
134 M: minnesota adjust-allowances ( salary w4 collector -- newsalary )
135 drop calculate-w4-allowances - ;
137 M: minnesota withholding ( salary w4 collector -- x )
138 [ adjust-allowances ] 2keep marriage-table tax ;
140 : employer-withhold ( salary w4 collector -- x )
141 [ withholding ] 3keep
142 dup federal? [ 3drop ] [ drop <federal> withholding + ] if ;
144 : net ( salary w4 collector -- x )
145 >r dupd r> employer-withhold - ;