From 8c14af3f6c8ed0a6bf5e0d2c6f89b94fd12abb78 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 14 Sep 2009 15:03:05 -0500
Subject: [PATCH] add a number-base configuration variable to
 prettyprint.config. set to 2 to print BIN:, 8 to print OCT:, 10 to print
 decimal, 16 to print HEX:

---
 basis/prettyprint/backend/backend.factor   | 15 +++++++++++++--
 basis/prettyprint/config/config.factor     |  2 ++
 basis/prettyprint/prettyprint-tests.factor |  8 ++++++++
 core/math/parser/parser.factor             |  6 ++----
 4 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index f8bcb66b1e..cba40bbff1 100644
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -45,12 +45,23 @@ M: method-body pprint*
         ] "" make
     ] [ word-style ] bi styled-text ;
 
-M: real pprint* number>string text ;
+M: real pprint*
+    number-base get {
+        { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
+        {  8 [ \ OCT: [  8 >base text ] pprint-prefix ] }
+        {  2 [ \ BIN: [  2 >base text ] pprint-prefix ] }
+        [ drop number>string text ]
+    } case ;
 
 M: float pprint*
     dup fp-nan? [
         \ NAN: [ fp-nan-payload >hex text ] pprint-prefix
-    ] [ call-next-method ] if ;
+    ] [
+        number-base get {
+            { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
+            [ drop number>string text ]
+        } case
+    ] if ;
 
 M: f pprint* drop \ f pprint-word ;
 
diff --git a/basis/prettyprint/config/config.factor b/basis/prettyprint/config/config.factor
index d42b134d4c..45557925a5 100644
--- a/basis/prettyprint/config/config.factor
+++ b/basis/prettyprint/config/config.factor
@@ -11,9 +11,11 @@ SYMBOL: margin
 SYMBOL: nesting-limit
 SYMBOL: length-limit
 SYMBOL: line-limit
+SYMBOL: number-base
 SYMBOL: string-limit?
 SYMBOL: boa-tuples?
 SYMBOL: c-object-pointers?
 
 4 tab-size set-global
 64 margin set-global
+10 number-base set-global
diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor
index b3897960f0..db3331305e 100644
--- a/basis/prettyprint/prettyprint-tests.factor
+++ b/basis/prettyprint/prettyprint-tests.factor
@@ -8,7 +8,15 @@ listener ;
 IN: prettyprint.tests
 
 [ "4" ] [ 4 unparse ] unit-test
+[ "4096" ] [ 4096 unparse ] unit-test
+[ "BIN: 1000000000000" ] [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "OCT: 10000" ] [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "HEX: 1000" ] [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
 [ "1.0" ] [ 1.0 unparse ] unit-test
+[ "8.0" ] [ 8.0 unparse ] unit-test
+[ "8.0" ] [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "8.0" ] [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "HEX: 1.0p3" ] [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
 
 [ "+" ] [ \ + unparse ] unit-test
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index 8e911453ad..d422a2c199 100644
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -109,9 +109,8 @@ SYMBOL: negative?
 
 : base>float ( str base -- n/f )
     {
-        { 10 [ dec>float ] }
         { 16 [ hex>float ] }
-        [ "Floats can only be converted from strings in base 10 or 16" throw ]
+        [ drop dec>float ]
     } case ;
 
 : number-char? ( char -- ? )
@@ -232,9 +231,8 @@ M: ratio >base
 
 : float>base ( n base -- str )
     {
-        { 10 [ float>decimal ] }
         { 16 [ float>hex ] }
-        [ "Floats can only be converted to strings in base 10 or 16" throw ]
+        [ drop float>decimal ]
     } case ;
 
 PRIVATE>