From 99e685ce613d5f0246b0c26aa0c64410f71ba03e Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Mon, 6 Jul 2015 13:33:02 -0700 Subject: [PATCH] Add procedure CUBE. --- src/runtime/arith.scm | 10 ++++++++++ src/runtime/runtime.pkg | 1 + 2 files changed, 11 insertions(+) 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 -- 2.25.1