From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Mon, 6 Jul 2015 20:33:02 +0000 (-0700)
Subject: Add procedure CUBE.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~82
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=99e685ce613d5f0246b0c26aa0c64410f71ba03e;p=mit-scheme.git

Add procedure CUBE.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index c29a6c424..8f81669eb 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -632,6 +632,12 @@ USA.
       (make-ratnum (let ((n (ratnum-numerator q))) (int:* n n))
 		   (let ((d (ratnum-denominator q))) (int:* d d)))
       (int:* q q)))
+
+(define (rat:cube q)
+  (if (ratnum? q)
+      (make-ratnum (let ((n (ratnum-numerator q))) (int:* n (int:* n n)))
+		   (let ((d (ratnum-denominator q))) (int:* d (int:* d d))))
+      (int:* q (int:* q q))))
 
 (define (rat:/ u/u* v/v*)
   (declare (integrate-operator rat:sign-correction))
@@ -998,6 +1004,7 @@ USA.
 (define-standard-unary real:invert (lambda (x) (flo:/ flo:1 x)) rat:invert)
 (define-standard-unary real:abs flo:abs rat:abs)
 (define-standard-unary real:square (lambda (x) (flo:* x x)) rat:square)
+(define-standard-unary real:cube (lambda (x) (flo:* x (flo:* x x))) rat:cube)
 (define-standard-unary real:floor flo:floor rat:floor)
 (define-standard-unary real:ceiling flo:ceiling rat:ceiling)
 (define-standard-unary real:truncate flo:truncate rat:truncate)
@@ -1947,6 +1954,9 @@ USA.
 
 (define (square z)
   (complex:* z z))
+
+(define (cube z)
+  (complex:* z (complex:* z z)))
 
 ;;; Replaced with arity-dispatched version in INITIALIZE-PACKAGE!.
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 03df60fe0..1b97debfd 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2925,6 +2925,7 @@ USA.
 	  >
 	  >=
 	  atan
+	  cube
 	  error:not-complex
 	  error:not-exact
 	  error:not-exact-integer