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

diff --git a/extra/money/money-tests.factor b/extra/money/money-tests.factor
index 78c168015f9e7484eb10b45eaac0d2e660d6d131..226b7126766b84bd0c11559bf80e89c66ab0d08a 100644 (file)
--- a/extra/money/money-tests.factor
+++ b/extra/money/money-tests.factor
@@ -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

diff --git a/extra/money/money.factor b/extra/money/money.factor
index 5fa76d5f531be6676644d9f9e4e2dfc2b4368cd4..b7da97ca0676abbe5ece0e73ee9ad38ae6190836 100644 (file)
--- a/extra/money/money.factor
+++ b/extra/money/money.factor
@@ -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: