steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.parser: natively support 0b 0o 0x syntax 

Closes #371
db4
Joe Groff 2011-11-23 18:29:39 -08:00
parent 29bf4d7214
commit e738c7206c
2 changed files with 40 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
core/math/parser/parser-tests.factor
View File

@ -237,3 +237,23 @@ unit-test
[ 1/0. ] [ "1.0p1024" hex> ] unit-test [ 1/0. ] [ "1.0p1024" hex> ] 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

21
core/math/parser/parser.factor
View File

@ -1,7 +1,7 @@
! (c)2009 Joe Groff bsd license ! (c)2009 Joe Groff bsd license
USING: accessors byte-arrays combinators kernel kernel.private USING: accessors byte-arrays combinators kernel kernel.private
math namespaces sequences sequences.private splitting strings math namespaces sequences sequences.private splitting strings
make ; make generalizations ;
IN: math.parser IN: math.parser
: digit> ( ch -- n ) : digit> ( ch -- n )
@ -208,9 +208,27 @@ DEFER: @neg-digit
{ fixnum number-parse integer fixnum } declare { fixnum number-parse integer fixnum } declare
digit-in-radix [ [ @pos-digit-or-punc ] add-digit ] [ @abort ] if ; 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 ) : @pos-first-digit ( i number-parse n char -- n/f )
{ {
{ CHAR: . [ ->required-mantissa ] } { CHAR: . [ ->required-mantissa ] }
{ CHAR: 0 [ [ @pos-digit ] [ @pos-digit-or-punc ] with-radix-char ] }
[ @pos-digit ] [ @pos-digit ]
} case ; inline } case ; inline
@ -230,6 +248,7 @@ DEFER: @neg-digit
: @neg-first-digit ( i number-parse n char -- n/f ) : @neg-first-digit ( i number-parse n char -- n/f )
{ {
{ CHAR: . [ ->required-mantissa ] } { CHAR: . [ ->required-mantissa ] }
{ CHAR: 0 [ [ @neg-digit ] [ @neg-digit-or-punc ] with-radix-char ] }
[ @neg-digit ] [ @neg-digit ]
} case ; inline } case ; inline