Rice
parent
f28dde2c65
commit
f5acf7e3d6
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.private namespaces make sequences strings
|
||||
arrays combinators splitting math assocs ;
|
||||
USING: kernel math.private namespaces sequences strings
|
||||
arrays combinators splitting math assocs make ;
|
||||
IN: math.parser
|
||||
|
||||
: digit> ( ch -- n )
|
||||
|
@ -94,10 +94,10 @@ PRIVATE>
|
|||
: >digit ( n -- ch )
|
||||
dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ;
|
||||
|
||||
: integer, ( num radix -- )
|
||||
: positive>base ( num radix -- str )
|
||||
dup 1 <= [ "Invalid radix" throw ] when
|
||||
[ /mod >digit , ] keep over 0 >
|
||||
[ integer, ] [ 2drop ] if ;
|
||||
[ dup 0 > ] swap [ /mod >digit ] curry [ ] "" produce-as nip
|
||||
dup reverse-here ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -110,24 +110,27 @@ GENERIC# >base 1 ( n radix -- str )
|
|||
PRIVATE>
|
||||
|
||||
M: integer >base
|
||||
[
|
||||
over 0 < [
|
||||
swap neg swap integer, CHAR: - ,
|
||||
over 0 = [
|
||||
2drop "0"
|
||||
] [
|
||||
over 0 > [
|
||||
positive>base
|
||||
] [
|
||||
integer,
|
||||
[ neg ] dip positive>base CHAR: - prefix
|
||||
] if
|
||||
] "" make reverse ;
|
||||
] if ;
|
||||
|
||||
M: ratio >base
|
||||
[
|
||||
dup 0 < negative? set
|
||||
1 /mod
|
||||
[ dup zero? [ drop "" ] [ (>base) sign append ] if ]
|
||||
[
|
||||
dup 0 < dup negative? set [ "-" % neg ] when
|
||||
1 /mod
|
||||
>r dup zero? [ drop ] [ (>base) % sign % ] if r>
|
||||
dup numerator (>base) %
|
||||
"/" %
|
||||
denominator (>base) %
|
||||
] "" make
|
||||
[ numerator (>base) ]
|
||||
[ denominator (>base) ] bi
|
||||
"/" swap 3append
|
||||
] bi* append
|
||||
negative? get [ CHAR: - prefix ] when
|
||||
] with-radix ;
|
||||
|
||||
: fix-float ( str -- newstr )
|
||||
|
|
|
@ -454,8 +454,11 @@ PRIVATE>
|
|||
: accumulator ( quot -- quot' vec )
|
||||
V{ } clone [ [ push ] curry compose ] keep ; inline
|
||||
|
||||
: produce-as ( pred quot tail exemplar -- seq )
|
||||
>r swap accumulator >r swap while r> r> like ; inline
|
||||
|
||||
: produce ( pred quot tail -- seq )
|
||||
swap accumulator >r swap while r> { } like ; inline
|
||||
{ } produce-as ; inline
|
||||
|
||||
: follow ( obj quot -- seq )
|
||||
>r [ dup ] r> [ keep ] curry [ ] produce nip ; inline
|
||||
|
|
Loading…
Reference in New Issue