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

DECIMAL: 23 did not parse. remove >r, add symbol for currency

db4
Doug Coleman 2008-11-29 12:03:07 -06:00
parent 6756613b29
commit 1ba6eee2c0
2 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/money/money-tests.factor
View File

@ -12,10 +12,14 @@ IN: money.tests
[ 1/10 ] [ DECIMAL: .1 ] unit-test [ 1/10 ] [ DECIMAL: .1 ] unit-test
[ 1/10 ] [ DECIMAL: 0.1 ] unit-test [ 1/10 ] [ DECIMAL: 0.1 ] unit-test
[ 1/10 ] [ DECIMAL: 00.10 ] unit-test [ 1/10 ] [ DECIMAL: 00.10 ] unit-test
[ 23 ] [ DECIMAL: 23 ] unit-test
[ -23 ] [ DECIMAL: -23 ] unit-test
[ -23-1/100 ] [ DECIMAL: -23.01 ] unit-test
[ "DECIMAL: ." eval ] must-fail [ "DECIMAL: ." eval ] must-fail
[ "DECIMAL: f" eval ] must-fail [ "DECIMAL: f" eval ] must-fail
[ "DECIMAL: 0.f" eval ] must-fail [ "DECIMAL: 0.f" eval ] must-fail
[ "DECIMAL: f.0" eval ] must-fail [ "DECIMAL: f.0" eval ] must-fail
[ "$100.00" ] [ DECIMAL: 100.0 money>string ] unit-test
[ "$0.00" ] [ DECIMAL: 0.0 money>string ] unit-test

27
extra/money/money.factor
View File

@ -3,28 +3,31 @@ namespaces make sequences splitting grouping combinators
continuations ; continuations ;
IN: money IN: money
SYMBOL: currency-token
CHAR: $ \ currency-token set-global
: dollars/cents ( dollars -- dollars cents ) : dollars/cents ( dollars -- dollars cents )
100 * 100 /mod round ; 100 * 100 /mod round ;
: (money>string) ( dollars cents -- string )
[ number>string ] bi@
[ <reversed> 3 group "," join <reversed> ]
[ 2 CHAR: 0 pad-left ] bi* "." swap 3append ;
: money>string ( object -- string ) : money>string ( object -- string )
dollars/cents [ dollars/cents (money>string) currency-token get prefix ;
"$" %
swap number>string
<reversed> 3 group "," join <reversed> %
"." % number>string 2 CHAR: 0 pad-left %
] "" make ;
: money. ( object -- ) : money. ( object -- ) money>string print ;
money>string print ;
ERROR: not-a-decimal x ; ERROR: not-an-integer x ;
: parse-decimal ( str -- ratio ) : parse-decimal ( str -- ratio )
"." split1 "." split1
>r dup "-" head? [ drop t "0" ] [ f swap ] if r> [ "-" ?head swap ] dip
[ [ "0" ] when-empty ] bi@ [ [ "0" ] when-empty ] bi@
dup length [
>r [ dup string>number [ nip ] [ not-a-decimal ] if* ] bi@ r> [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
] keep length
10 swap ^ / + swap [ neg ] when ; 10 swap ^ / + swap [ neg ] when ;
: DECIMAL: : DECIMAL: