extra/taxes/usa/federal/federal.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math money taxes.usa taxes.usa.fica
   4 taxes.usa.medicare taxes.usa.w4 ;
   5 IN: taxes.usa.federal
   6
   7 ! http://www.irs.gov/pub/irs-pdf/p15.pdf
   8 ! Table 7 ANNUAL Payroll Period
   9
  10 : federal-single ( -- triples )
  11     {
  12         {      0   2650 DECIMAL: 0   }
  13         {   2650  10300 DECIMAL: .10 }
  14         {  10300  33960 DECIMAL: .15 }
  15         {  33960  79725 DECIMAL: .25 }
  16         {  79725 166500 DECIMAL: .28 }
  17         { 166500 359650 DECIMAL: .33 }
  18         { 359650   1/0. DECIMAL: .35 }
  19     } ;
  20
  21 : federal-married ( -- triples )
  22     {
  23         {      0   8000 DECIMAL: 0   }
  24         {   8000  23550 DECIMAL: .10 }
  25         {  23550  72150 DECIMAL: .15 }
  26         {  72150 137850 DECIMAL: .25 }
  27         { 137850 207700 DECIMAL: .28 }
  28         { 207700 365100 DECIMAL: .33 }
  29         { 365100   1/0. DECIMAL: .35 }
  30     } ;
  31
  32 SINGLETON: federal
  33 : <federal> ( -- obj )
  34     federal federal-single federal-married <tax-table> ;
  35
  36 : federal-tax ( salary w4 tax-table -- n )
  37     [ adjust-allowances ] 2keep marriage-table tax ;
  38
  39 M: federal adjust-allowances* ( salary w4 collector entity -- newsalary )
  40     2drop calculate-w4-allowances - ;
  41
  42 M: federal withholding* ( salary w4 tax-table entity -- x )
  43     drop
  44     [ federal-tax ] 2keepd
  45     [ fica-tax ] 2keep
  46     medicare-tax + + ;
  47
  48 : total-withholding ( salary w4 tax-table -- x )
  49     dup entity>> dup federal = [
  50         withholding*
  51     ] [
  52         drop
  53         [ drop <federal> federal withholding* ]
  54         [ dup entity>> withholding* ] 3bi +
  55     ] if ;
  56
  57 : net ( salary w4 collector -- x )
  58     [ dupd ] dip total-withholding - ;