extra/money/money.factor

   1 USING: io kernel math math.functions math.parser parser lexer
   2 namespaces make sequences splitting grouping combinators
   3 continuations ;
   4 IN: money
   5
   6 SYMBOL: currency-token
   7 CHAR: $ \ currency-token set-global
   8
   9 : dollars/cents ( dollars -- dollars cents )
  10     100 * 100 /mod round ;
  11
  12 : (money>string) ( dollars cents -- string )
  13     [ number>string ] bi@
  14     [ <reversed> 3 group "," join <reversed> ]
  15     [ 2 CHAR: 0 pad-left ] bi* "." glue ;
  16
  17 : money>string ( object -- string )
  18     dollars/cents (money>string) currency-token get prefix ;
  19
  20 : money. ( object -- ) money>string print ;
  21
  22 ERROR: not-an-integer x ;
  23
  24 : parse-decimal ( str -- ratio )
  25     "." split1
  26     [ "-" ?head swap ] dip
  27     [ [ "0" ] when-empty ] bi@
  28     [
  29         [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
  30     ] keep length
  31     10 swap ^ / + swap [ neg ] when ;
  32
  33 : DECIMAL:
  34     scan parse-decimal parsed ; parsing