From e84e508256ac09ba7cd6aa4298bfa7a013286243 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Mon, 10 Sep 2012 19:53:25 -0700
Subject: [PATCH] math.ratios: speed up some operations on ratios.

---
 .../propagation/known-words/known-words.factor    |  4 ++--
 basis/math/functions/functions.factor             |  7 +++++--
 basis/math/ratios/ratios.factor                   | 15 +++++++++------
 3 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 3d263b5754..563abc8e52 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -3,7 +3,7 @@
 USING: effects accessors kernel kernel.private layouts math
 math.private math.integers.private math.floats.private
 math.partial-dispatch math.intervals math.parser math.order
-math.functions math.libm namespaces words sequences
+math.functions math.libm math.ratios namespaces words sequences
 sequences.private arrays assocs classes classes.algebra
 combinators generic.math splitting fry locals classes.tuple
 alien.accessors classes.tuple.private slots.private definitions
@@ -239,7 +239,7 @@ generic-comparison-ops [
     '[ _ swap interval>> <class/interval-info> ] "outputs" set-word-prop
 ] assoc-each
 
-{ numerator denominator }
+{ numerator denominator >fraction }
 [ [ drop integer <class-info> ] "outputs" set-word-prop ] each
 
 { (log2) fixnum-log2 bignum-log2 } [
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 5c3720c99c..d2dd108549 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -4,8 +4,11 @@ USING: math kernel math.constants math.private math.bits
 math.libm combinators fry math.order sequences ;
 IN: math.functions
 
-: >fraction ( a/b -- a b )
-    [ numerator ] [ denominator ] bi ; inline
+GENERIC: >fraction ( a/b -- a b )
+
+M: integer >fraction 1 ; inline
+
+M: ratio >fraction [ numerator ] [ denominator ] bi ; inline
 
 : rect> ( x y -- z )
     ! Note: an imaginary 0.0 should still create a complex
diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor
index b71d28f7da..1b8072bcd1 100644
--- a/basis/math/ratios/ratios.factor
+++ b/basis/math/ratios/ratios.factor
@@ -12,11 +12,14 @@ IN: math.ratios
 : fraction> ( a b -- a/b )
     dup 1 number= [ drop ] [ ratio boa ] if ; inline
 
-: scale ( a/b c/d -- a*d b*c )
-    2>fraction [ * swap ] dip * swap ; inline
+: (scale) ( a b c d -- a*d b*c )
+    [ * swap ] dip * swap ; inline
 
-: ratio+d ( a/b c/d -- b*d )
-    [ denominator ] bi@ * ; inline
+: scale ( a/b c/d -- a*d b*c )
+    2>fraction (scale) ; inline
+
+: scale+d ( a/b c/d -- a*d b*c b*d )
+    2>fraction [ (scale) ] 2keep * ; inline
 
 PRIVATE>
 
@@ -66,8 +69,8 @@ M: ratio <= scale <= ;
 M: ratio > scale > ;
 M: ratio >= scale >= ;
 
-M: ratio + [ scale + ] [ ratio+d ] 2bi / ;
-M: ratio - [ scale - ] [ ratio+d ] 2bi / ;
+M: ratio + scale+d [ + ] [ / ] bi* ;
+M: ratio - scale+d [ - ] [ / ] bi* ;
 M: ratio * 2>fraction [ * ] 2bi@ / ;
 M: ratio / scale / ;
 M: ratio /i scale /i ;