From e738c7206c32bd9b76f3cee31e950835e1b1ee24 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 23 Nov 2011 18:29:39 -0800
Subject: [PATCH] math.parser: natively support 0b 0o 0x syntax Closes #371

---
 core/math/parser/parser-tests.factor | 20 ++++++++++++++++++++
 core/math/parser/parser.factor       | 21 ++++++++++++++++++++-
 2 files changed, 40 insertions(+), 1 deletion(-)

diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor
index dac2e34f10..339c091a0c 100644
--- a/core/math/parser/parser-tests.factor
+++ b/core/math/parser/parser-tests.factor
@@ -237,3 +237,23 @@ unit-test
 [ 1/0. ] [ "1.0p1024" hex> ] unit-test
 [ -1/0. ] [ "-1.0p1024" hex> ] unit-test
 
+[ 0 ] [ "0" string>number ] unit-test
+[ 0 ] [ "00" string>number ] unit-test
+[ 0.0 ] [ "0." string>number ] unit-test
+[ 0.0 ] [ "0.0" string>number ] unit-test
+[ 0.0 ] [ "0x0.0p0" string>number ] unit-test
+[ 0 ] [ "0x0" string>number ] unit-test
+[ 0 ] [ "0o0" string>number ] unit-test
+[ 0 ] [ "0b0" string>number ] unit-test
+
+[ 10 ] [ "010" string>number ] unit-test
+[ 16 ] [ "0x10" string>number ] unit-test
+[  8 ] [ "0o10" string>number ] unit-test
+[  2 ] [ "0b10" string>number ] unit-test
+
+[ -10 ] [ "-010" string>number ] unit-test
+[ -16 ] [ "-0x10" string>number ] unit-test
+[  -8 ] [ "-0o10" string>number ] unit-test
+[  -2 ] [ "-0b10" string>number ] unit-test
+
+[ 1.0 ] [ "0x1.0p0" string>number ] unit-test
diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index b270b57fa2..c9ef5512d4 100644
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -1,7 +1,7 @@
 ! (c)2009 Joe Groff bsd license
 USING: accessors byte-arrays combinators kernel kernel.private
 math namespaces sequences sequences.private splitting strings
-make ;
+make generalizations ;
 IN: math.parser
 
 : digit> ( ch -- n )
@@ -208,9 +208,27 @@ DEFER: @neg-digit
     { fixnum number-parse integer fixnum } declare
     digit-in-radix [ [ @pos-digit-or-punc ] add-digit ] [ @abort ] if ;
 
+: (->radix) ( number-parse radix -- number-parse' )
+    [ [ str>> ] [ length>> ] bi ] dip number-parse boa ; inline
+
+: ->radix ( i number-parse n quot radix -- i number-parse n quot )
+    [ (->radix) ] curry 2dip ; inline
+
+: with-radix-char ( i number-parse n radix-quot nonradix-quot -- n/f )
+    [
+        rot {
+            { CHAR: b [ drop  2 ->radix next-digit ] }
+            { CHAR: o [ drop  8 ->radix next-digit ] }
+            { CHAR: x [ drop 16 ->radix next-digit ] }
+            { f       [ 3drop 2drop 0 ] }
+            [ [ drop ] 2dip swap call ]
+        } case
+    ] 2curry next-digit ; inline
+
 : @pos-first-digit ( i number-parse n char -- n/f )
     {
         { CHAR: . [ ->required-mantissa ] }
+        { CHAR: 0 [ [ @pos-digit ] [ @pos-digit-or-punc ] with-radix-char ] }
         [ @pos-digit ]
     } case ; inline
 
@@ -230,6 +248,7 @@ DEFER: @neg-digit
 : @neg-first-digit ( i number-parse n char -- n/f )
     {
         { CHAR: . [ ->required-mantissa ] }
+        { CHAR: 0 [ [ @neg-digit ] [ @neg-digit-or-punc ] with-radix-char ] }
         [ @neg-digit ]
     } case ; inline
 
-- 
2.34.1