DECIMAL: 23 did not parse. remove >r, add symbol for currency
parent
6756613b29
commit
1ba6eee2c0
|
@ -12,10 +12,14 @@ IN: money.tests
|
|||
[ 1/10 ] [ DECIMAL: .1 ] unit-test
|
||||
[ 1/10 ] [ DECIMAL: 0.1 ] 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: f" eval ] must-fail
|
||||
[ "DECIMAL: 0.f" 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
|
||||
|
|
|
@ -3,28 +3,31 @@ namespaces make sequences splitting grouping combinators
|
|||
continuations ;
|
||||
IN: money
|
||||
|
||||
SYMBOL: currency-token
|
||||
CHAR: $ \ currency-token set-global
|
||||
|
||||
: dollars/cents ( dollars -- dollars cents )
|
||||
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 )
|
||||
dollars/cents [
|
||||
"$" %
|
||||
swap number>string
|
||||
<reversed> 3 group "," join <reversed> %
|
||||
"." % number>string 2 CHAR: 0 pad-left %
|
||||
] "" make ;
|
||||
dollars/cents (money>string) currency-token get prefix ;
|
||||
|
||||
: money. ( object -- )
|
||||
money>string print ;
|
||||
: money. ( object -- ) money>string print ;
|
||||
|
||||
ERROR: not-a-decimal x ;
|
||||
ERROR: not-an-integer x ;
|
||||
|
||||
: parse-decimal ( str -- ratio )
|
||||
"." split1
|
||||
>r dup "-" head? [ drop t "0" ] [ f swap ] if r>
|
||||
[ "-" ?head swap ] dip
|
||||
[ [ "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 ;
|
||||
|
||||
: DECIMAL:
|
||||
|
|
Loading…
Reference in New Issue