steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix taxes

db4
Doug Coleman 2008-10-02 19:03:57 -05:00
parent e0f681638b
commit 4c8ff1e289
4 changed files with 17 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/taxes/usa/federal/federal.factor
View File

@ -45,3 +45,15 @@ M: federal withholding* ( salary w4 tax-table entity -- x )
[ federal-tax ] 3keep drop [ federal-tax ] 3keep drop
[ fica-tax ] 2keep [ fica-tax ] 2keep
medicare-tax + + ; 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 )
>r dupd r> total-withholding - ;

2
extra/taxes/usa/fica/fica.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors math math.order money ; USING: accessors assocs.lib math math.order money ;
IN: taxes.usa.fica IN: taxes.usa.fica
: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline

4
extra/taxes/usa/usa-tests.factor
View File

@ -110,9 +110,9 @@ IN: taxes.usa.tests
[ 138 69 ] [ [ 138 69 ] [
24000 2008 2 f <w4> <federal> withholding biweekly dollars/cents 24000 2008 2 f <w4> <federal> total-withholding biweekly dollars/cents
] unit-test ] unit-test
[ 754 72 ] [ [ 754 72 ] [
78250 2008 2 f <w4> <federal> withholding biweekly dollars/cents 78250 2008 2 f <w4> <federal> total-withholding biweekly dollars/cents
] unit-test ] unit-test

13
extra/taxes/usa/usa.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs kernel math math.intervals USING: accessors arrays assocs kernel math math.intervals
namespaces sequences money math.order taxes.usa.w4 namespaces sequences money math.order taxes.usa.w4 ;
taxes.usa.federal ;
IN: taxes.usa IN: taxes.usa
! Withhold: FICA, Medicare, Federal (FICA is social security) ! Withhold: FICA, Medicare, Federal (FICA is social security)
@ -17,12 +16,7 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x )
dup entity>> adjust-allowances* ; dup entity>> adjust-allowances* ;
: withholding ( salary w4 tax-table -- x ) : withholding ( salary w4 tax-table -- x )
dup entity>> federal = [ dup entity>> withholding* ;
dup entity>> withholding*
] [
[ dup entity>> withholding* ]
[ drop <federal> federal withholding* ] 3bi +
] if ;
: tax-bracket-range ( pair -- n ) first2 swap - ; : tax-bracket-range ( pair -- n ) first2 swap - ;
@ -36,6 +30,3 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x )
: marriage-table ( w4 tax-table -- triples ) : marriage-table ( w4 tax-table -- triples )
swap married?>> swap married?>>
[ married>> ] [ single>> ] if ; [ married>> ] [ single>> ] if ;
: net ( salary w4 collector -- x )
>r dupd r> withholding - ;