From a79f202573194dc7e3bb4bf3d72253362e3e7053 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 10 Feb 2019 22:35:19 +0000 Subject: [PATCH] Convert multi-LETREC to internal definitions in arith.scm. --- src/runtime/arith.scm | 43 +++++++++++++++++++------------------------ 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm index 7307bb759..345d1b93e 100644 --- a/src/runtime/arith.scm +++ b/src/runtime/arith.scm @@ -921,30 +921,25 @@ USA. (let ((k (int:- (integer-length-in-bits n) (integer-length-in-bits d))) (p flo:significand-digits-base-2)) - (letrec - ((step1 - (lambda (n d) - ;; (assert (< (expt 2 (- k 1)) (/ n d) (expt 2 (+ k 1)))) - (if (int:negative? k) - (step2 (integer-shift-left n (int:negate k)) d) - (step2 n (integer-shift-left d k))))) - (step2 - (lambda (n d) - ;; (assert (< 1/2 (/ n d) 2)) - (if (int:< n d) - (step3 n d (int:- k p)) - (step3 n (int:* 2 d) (int:- (int:1+ k) p))))) - (step3 - (lambda (n d e) - ;; (assert (and (<= 1/2 (/ n d)) (< (/ n d) 1))) - (let ((n (int:round (integer-shift-left n p) d))) - (if (int:= n int:flonum-integer-limit) - (step4 (int:quotient n 2) (int:1+ e)) - (step4 n e))))) - (step4 - (lambda (n e) - (flo:denormalize (integer->flonum n #b11) e)))) - (step1 n d)))) + (define (step1 n d) + ;; (assert (< (expt 2 (- k 1)) (/ n d) (expt 2 (+ k 1)))) + (if (int:negative? k) + (step2 (integer-shift-left n (int:negate k)) d) + (step2 n (integer-shift-left d k)))) + (define (step2 n d) + ;; (assert (< 1/2 (/ n d) 2)) + (if (int:< n d) + (step3 n d (int:- k p)) + (step3 n (int:* 2 d) (int:- (int:1+ k) p)))) + (define (step3 n d e) + ;; (assert (and (<= 1/2 (/ n d)) (< (/ n d) 1))) + (let ((n (int:round (integer-shift-left n p) d))) + (if (int:= n int:flonum-integer-limit) + (step4 (int:quotient n 2) (int:1+ e)) + (step4 n e)))) + (define (step4 n e) + (flo:denormalize (integer->flonum n #b11) e)) + (step1 n d))) (define (slow-method n d) (if (int:positive? n) -- 2.25.1