Improve ratio syntax
parent
ab63c7254c
commit
2ecd1ba127
|
@ -41,6 +41,9 @@ DEFER: base>
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
SYMBOL: radix
|
SYMBOL: radix
|
||||||
|
SYMBOL: negative?
|
||||||
|
|
||||||
|
: sign negative? get "-" "+" ? ;
|
||||||
|
|
||||||
: with-radix ( radix quot -- )
|
: with-radix ( radix quot -- )
|
||||||
radix swap with-variable ; inline
|
radix swap with-variable ; inline
|
||||||
|
@ -48,7 +51,7 @@ SYMBOL: radix
|
||||||
: (base>) ( str -- n ) radix get base> ;
|
: (base>) ( str -- n ) radix get base> ;
|
||||||
|
|
||||||
: whole-part ( str -- m n )
|
: whole-part ( str -- m n )
|
||||||
"+" split1 >r (base>) r>
|
sign split1 >r (base>) r>
|
||||||
dup [ (base>) ] [ drop 0 swap ] if ;
|
dup [ (base>) ] [ drop 0 swap ] if ;
|
||||||
|
|
||||||
: string>ratio ( str -- a/b )
|
: string>ratio ( str -- a/b )
|
||||||
|
@ -70,7 +73,7 @@ PRIVATE>
|
||||||
|
|
||||||
: base> ( str radix -- n/f )
|
: base> ( str radix -- n/f )
|
||||||
[
|
[
|
||||||
"-" ?head >r
|
"-" ?head dup negative? set >r
|
||||||
{
|
{
|
||||||
{ [ CHAR: / over member? ] [ string>ratio ] }
|
{ [ CHAR: / over member? ] [ string>ratio ] }
|
||||||
{ [ CHAR: . over member? ] [ string>float ] }
|
{ [ CHAR: . over member? ] [ string>float ] }
|
||||||
|
@ -114,9 +117,9 @@ M: integer >base
|
||||||
M: ratio >base
|
M: ratio >base
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
dup 0 < [ "-" % neg ] when
|
dup 0 < dup negative? set [ "-" % neg ] when
|
||||||
1 /mod
|
1 /mod
|
||||||
>r dup zero? [ drop ] [ (>base) % "+" % ] if r>
|
>r dup zero? [ drop ] [ (>base) % sign % ] if r>
|
||||||
dup numerator (>base) %
|
dup numerator (>base) %
|
||||||
"/" %
|
"/" %
|
||||||
denominator (>base) %
|
denominator (>base) %
|
||||||
|
|
|
@ -107,6 +107,6 @@ unit-test
|
||||||
unit-test
|
unit-test
|
||||||
|
|
||||||
[ 3 ] [ "1+1/2" string>number 2 * ] unit-test
|
[ 3 ] [ "1+1/2" string>number 2 * ] unit-test
|
||||||
[ -3 ] [ "-1+1/2" string>number 2 * ] unit-test
|
[ -3 ] [ "-1-1/2" string>number 2 * ] unit-test
|
||||||
[ "2+1/7" ] [ 1 7 / 2 + number>string ] unit-test
|
[ "2+1/7" ] [ 1 7 / 2 + number>string ] unit-test
|
||||||
[ "1/8" ] [ 1 8 / number>string ] unit-test
|
[ "1/8" ] [ 1 8 / number>string ] unit-test
|
||||||
|
|
Loading…
Reference in New Issue