money: cleanup.
parent
f37da7b2eb
commit
0609f790c7
|
@ -1,33 +1,42 @@
|
|||
USING: io kernel math math.functions math.parser parser lexer
|
||||
namespaces make sequences splitting grouping combinators
|
||||
continuations ;
|
||||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: grouping io kernel lexer math math.functions math.parser
|
||||
namespaces sequences splitting ;
|
||||
IN: money
|
||||
|
||||
SYMBOL: currency-token
|
||||
CHAR: $ \ currency-token set-global
|
||||
CHAR: $ currency-token set-global
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: dollars/cents ( dollars -- dollars cents )
|
||||
100 * 100 /mod round ;
|
||||
|
||||
: (money>string) ( dollars cents -- string )
|
||||
: format-money ( dollars cents -- string )
|
||||
[ number>string ] bi@
|
||||
[ <reversed> 3 group "," join <reversed> ]
|
||||
[ 2 CHAR: 0 pad-head ] bi* "." glue ;
|
||||
|
||||
: money>string ( object -- string )
|
||||
dollars/cents (money>string) currency-token get prefix ;
|
||||
PRIVATE>
|
||||
|
||||
: money. ( object -- ) money>string print ;
|
||||
: money>string ( number -- string )
|
||||
dollars/cents format-money currency-token get prefix ;
|
||||
|
||||
: money. ( number -- ) money>string print ;
|
||||
|
||||
ERROR: not-an-integer x ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: split-decimal ( str -- neg? dollars cents )
|
||||
"." split1 [ "-" ?head swap ] dip ;
|
||||
|
||||
: parse-decimal ( str -- ratio )
|
||||
"." split1
|
||||
[ "-" ?head swap ] dip
|
||||
[ [ "0" ] when-empty ] bi@
|
||||
split-decimal [ [ "0" ] when-empty ] bi@
|
||||
[
|
||||
[ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
|
||||
] keep length
|
||||
10^ / + swap [ neg ] when ;
|
||||
] keep length 10^ / + swap [ neg ] when ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYNTAX: DECIMAL: scan-token parse-decimal suffix! ;
|
||||
|
|
Loading…
Reference in New Issue