From edb39fa1eeea135422ae0bb1f6c496bd72e7dfc5 Mon Sep 17 00:00:00 2001
From: Joe Marshall <eval.apply@gmail.com>
Date: Thu, 24 Mar 2011 13:48:13 -0700
Subject: [PATCH] Add numerator->exact and denominator->exact.

---
 src/runtime/arith.scm   | 18 ++++++++++++++++++
 src/runtime/runtime.pkg |  2 ++
 2 files changed, 20 insertions(+)

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index da78fef88..9944779a9 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1159,6 +1159,18 @@ USA.
 
 (define-rational-unary real:numerator rat:numerator)
 (define-rational-unary real:denominator rat:denominator)
+
+(define-syntax define-rational-exact-unary
+  (sc-macro-transformer
+   (lambda (form environment)
+     (let ((operator (close-syntax (list-ref form 2) environment)))
+       `(DEFINE (,(list-ref form 1) Q)
+	  (IF (FLONUM? Q)
+	      (,operator (FLO:->RATIONAL Q))
+	      (,operator Q)))))))
+
+(define-rational-exact-unary real:numerator->exact rat:numerator)
+(define-rational-exact-unary real:denominator->exact rat:denominator)
 
 (define-syntax define-transcendental-unary
   (sc-macro-transformer
@@ -1522,6 +1534,12 @@ USA.
 
 (define (complex:denominator q)
   (real:denominator (complex:real-arg 'DENOMINATOR q)))
+
+(define (complex:numerator->exact q)
+  (real:numerator->exact (complex:real-arg 'NUMERATOR->EXACT q)))
+
+(define (complex:denominator->exact q)
+  (real:denominator->exact (complex:real-arg 'DENOMINATOR->EXACT q)))
 
 (define (complex:floor x)
   (if (recnum? x)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9b5525cfb..836b5c91a 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2817,6 +2817,7 @@ USA.
 	  (conjugate complex:conjugate)
 	  (cos complex:cos)
 	  (denominator complex:denominator)
+	  (denominator->exact complex:denominator->exact)
 	  (even? complex:even?)
 	  (exact->inexact complex:exact->inexact)
 	  (exact-rational? rat:rational?)
@@ -2840,6 +2841,7 @@ USA.
 	  (negative? complex:negative?)
 	  (number? complex:complex?)
 	  (numerator complex:numerator)
+	  (numerator->exact complex:numerator->exact)
 	  (positive? complex:positive?)
 	  (rational? complex:rational?)
 	  (rationalize complex:rationalize)
-- 
2.25.1