factor: trim using lists

[factor.git] / extra / taxes / usa / federal / federal.factor

diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor
index 91d22ee828e6cf35bcc799b98a220edc2c244be4..908cfee63afbf9a966f4572f49a7b9c3d989fedd 100644 (file)
--- a/extra/taxes/usa/federal/federal.factor
+++ b/extra/taxes/usa/federal/federal.factor
@@ -1,12 +1,11 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel math math.intervals
-namespaces sequences combinators.lib money math.order
-taxes.usa.fica taxes.usa.medicare taxes.usa taxes.usa.w4 ;
+USING: accessors kernel math money taxes.usa taxes.usa.fica
+taxes.usa.medicare taxes.usa.w4 ;
 IN: taxes.usa.federal
 
 ! http://www.irs.gov/pub/irs-pdf/p15.pdf
-! Table 7 ANNUAL Payroll Period 
+! Table 7 ANNUAL Payroll Period
 
 : federal-single ( -- triples )
     {
@@ -42,6 +41,18 @@ M: federal adjust-allowances* ( salary w4 collector entity -- newsalary )
 
 M: federal withholding* ( salary w4 tax-table entity -- x )
     drop
-    [ federal-tax ] 3keep drop
+    [ federal-tax ] 2keepd
     [ fica-tax ] 2keep
     medicare-tax + + ;
+
+: total-withholding ( salary w4 tax-table -- x )
+    dup entity>> dup federal = [
+        withholding*
+    ] [
+        drop
+        [ drop <federal> federal withholding* ]
+        [ dup entity>> withholding* ] 3bi +
+    ] if ;
+
+: net ( salary w4 collector -- x )
+    [ dupd ] dip total-withholding - ;