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

Rice

db4
Slava Pestov 2008-09-27 17:54:44 -05:00
parent f28dde2c65
commit f5acf7e3d6
2 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private namespaces make sequences strings USING: kernel math.private namespaces sequences strings
arrays combinators splitting math assocs ; arrays combinators splitting math assocs make ;
IN: math.parser IN: math.parser
: digit> ( ch -- n ) : digit> ( ch -- n )
@ -94,10 +94,10 @@ PRIVATE>
: >digit ( n -- ch ) : >digit ( n -- ch )
dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ; dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ;
: integer, ( num radix -- ) : positive>base ( num radix -- str )
dup 1 <= [ "Invalid radix" throw ] when dup 1 <= [ "Invalid radix" throw ] when
[ /mod >digit , ] keep over 0 > [ dup 0 > ] swap [ /mod >digit ] curry [ ] "" produce-as nip
[ integer, ] [ 2drop ] if ; dup reverse-here ; inline
PRIVATE> PRIVATE>
@ -110,24 +110,27 @@ GENERIC# >base 1 ( n radix -- str )
PRIVATE> PRIVATE>
M: integer >base M: integer >base
[ over 0 = [
over 0 < [ 2drop "0"
swap neg swap integer, CHAR: - ,
] [ ] [
integer, over 0 > [
positive>base
] [
[ neg ] dip positive>base CHAR: - prefix
] if ] if
] "" make reverse ; ] if ;
M: ratio >base M: ratio >base
[ [
[ dup 0 < negative? set
dup 0 < dup negative? set [ "-" % neg ] when
1 /mod 1 /mod
>r dup zero? [ drop ] [ (>base) % sign % ] if r> [ dup zero? [ drop "" ] [ (>base) sign append ] if ]
dup numerator (>base) % [
"/" % [ numerator (>base) ]
denominator (>base) % [ denominator (>base) ] bi
] "" make "/" swap 3append
] bi* append
negative? get [ CHAR: - prefix ] when
] with-radix ; ] with-radix ;
: fix-float ( str -- newstr ) : fix-float ( str -- newstr )

5
core/sequences/sequences.factor
View File

@ -454,8 +454,11 @@ PRIVATE>
: accumulator ( quot -- quot' vec ) : accumulator ( quot -- quot' vec )
V{ } clone [ [ push ] curry compose ] keep ; inline 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 ) : produce ( pred quot tail -- seq )
swap accumulator >r swap while r> { } like ; inline { } produce-as ; inline
: follow ( obj quot -- seq ) : follow ( obj quot -- seq )
>r [ dup ] r> [ keep ] curry [ ] produce nip ; inline >r [ dup ] r> [ keep ] curry [ ] produce nip ; inline