Rice

core/math/parser/parser.factor

@@ -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
+USING: kernel math.private namespaces sequences strings
-arrays combinators splitting math assocs ;
+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 >
+    [ dup 0 > ] swap [ /mod >digit ] curry [ ] "" produce-as nip
-    [ integer, ] [ 2drop ] if ;
+    dup reverse-here ; inline
 
 PRIVATE>
 
@@ -110,24 +110,27 @@ GENERIC# >base 1 ( n radix -- str )
 PRIVATE>
 
 M: integer >base
-    [
+    over 0 = [
-        over 0 < [
+        2drop "0"
-            swap neg swap integer, CHAR: - ,
+    ] [
+        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
+            [ numerator (>base) ]
-            1 /mod
+            [ denominator (>base) ] bi
-            >r dup zero? [ drop ] [ (>base) % sign % ] if r>
+            "/" swap 3append
-            dup numerator (>base) %
+        ] bi* append
-            "/" %
+        negative? get [ CHAR: - prefix ] when
-            denominator (>base) %
-        ] "" make
     ] with-radix ;
 
 : fix-float ( str -- newstr )

core/sequences/sequences.factor

@@ -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