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

Fix more math.parser stuff

db4
Slava Pestov 2008-07-20 04:05:09 -05:00
parent 71638e6340
commit 35bd2abc71
2 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -101,4 +101,10 @@ unit-test
[ "-1.0/0.0" ] [ -1.0 0.0 / number>string ] unit-test [ "-1.0/0.0" ] [ -1.0 0.0 / number>string ] unit-test
[ 0.0/0.0 ] [ "0/0." string>number ] unit-test
[ 1.0/0.0 ] [ "1/0." string>number ] unit-test
[ -1.0/0.0 ] [ "-1/0." string>number ] unit-test
[ "-0.0" ] [ -0.0 number>string ] unit-test [ "-0.0" ] [ -0.0 number>string ] unit-test

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

@ -55,8 +55,9 @@ SYMBOL: negative?
dup [ (base>) ] [ drop 0 swap ] if ; dup [ (base>) ] [ drop 0 swap ] if ;
: string>ratio ( str -- a/b ) : string>ratio ( str -- a/b )
"-" ?head dup negative? set swap
"/" split1 (base>) >r whole-part r> "/" split1 (base>) >r whole-part r>
3dup and and [ / + ] [ 3drop f ] if ; 3dup and and [ / + swap [ neg ] when ] [ 2drop 2drop f ] if ;
: valid-digits? ( seq -- ? ) : valid-digits? ( seq -- ? )
{ {
@ -66,20 +67,22 @@ SYMBOL: negative?
} cond ; } cond ;
: string>integer ( str -- n/f ) : string>integer ( str -- n/f )
"-" ?head swap
string>digits dup valid-digits? string>digits dup valid-digits?
[ radix get digits>integer ] [ drop f ] if ; [ radix get digits>integer swap [ neg ] when ] [ 2drop f ] if ;
PRIVATE> PRIVATE>
: base> ( str radix -- n/f ) : base> ( str radix -- n/f )
[ [
CHAR: / over member? [
string>ratio
] [
CHAR: . over member? [ CHAR: . over member? [
string>float string>float
] [ ] [
"-" ?head dup negative? set >r string>integer
CHAR: / over member? ] if
[ string>ratio ] [ string>integer ] if
r> [ dup [ neg ] when ] when
] if ] if
] with-radix ; ] with-radix ;