/usr/share/scheme48-1.9/rts/innum.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
; Inexact numbers as mere shells surrounding exact numbers.
(define-extended-number-type <innum> (<inexact>)
(make-innum exact)
innum?
(exact innum-exact))
(define-method &exact? ((n <innum>)) #f)
(define-method &complex? ((n <innum>)) (complex? (innum-exact n)))
(define-method &real? ((n <innum>)) (real? (innum-exact n)))
(define-method &rational? ((n <innum>)) (rational? (innum-exact n)))
(define-method &integer? ((n <innum>)) (integer? (innum-exact n)))
(define-method &exact->inexact ((n <number>))
(if (innum? n)
(next-method)
(make-innum n)))
(define-method &inexact->exact ((n <innum>)) (innum-exact n))
(define (inexactify n)
(if (exact? n)
(exact->inexact n)
n))
(define (define-innum-method mtable proc)
(define-method mtable ((m <innum>) (n <number>))
(inexactify (proc (innum-exact m) n)))
(define-method mtable ((m <number>) (n <innum>))
(inexactify (proc m (innum-exact n)))))
(define-innum-method &+ +)
(define-innum-method &- -)
(define-innum-method &* *)
(define-innum-method &/ /)
(define-innum-method "ient quotient)
(define-innum-method &remainder remainder)
(define (define-innum-comparison mtable proc)
(define-method mtable ((m <innum>) (n <number>))
(proc (innum-exact m) n))
(define-method mtable ((m <number>) (n <innum>))
(proc m (innum-exact n))))
(define-innum-comparison &= =)
(define-innum-comparison &< <)
(define-method &numerator ((n <innum>))
(inexactify (numerator (innum-exact n))))
(define-method &denominator ((n <innum>))
(inexactify (denominator (innum-exact n))))
(define-method &floor ((n <innum>))
(inexactify (floor (innum-exact n))))
(define-method &number->string ((i <innum>) radix)
(let ((n (innum-exact i)))
(cond ((integer? n)
(string-append (number->string n radix) "."))
((rational? n)
(let ((q (denominator n)))
(if (= radix 10)
(let ((foo (decimable? q)))
(if foo
(decimal-representation (numerator n) q foo)
(string-append "#i" (number->string n radix))))
(string-append "#i" (number->string n radix)))))
(else
(string-append "#i" (number->string n radix))))))
; The Scheme report obligates us to print inexact rationals using
; decimal points whenever this can be done without losing precision.
(define (decimal-representation p q foo)
(let ((kludge (number->string (* (car foo) (abs (remainder p q)))
10)))
(string-append (if (< p 0) "-" "")
(number->string (quotient (abs p) q) 10)
"."
(string-append (do ((i (- (cdr foo) (string-length kludge))
(- i 1))
(l '() (cons #\0 l)))
((<= i 0) (list->string l)))
kludge))))
(define (ratio-string p q radix)
(string-append (number->string p radix)
"/"
(number->string q radix)))
; (decimable? n) => non-#f iff n is a product of 2's and 5's.
; The value returned is (k . i) such that 10^i divides n * k.
(define (decimable? n)
(let loop ((n n) (d 1) (i 0))
(if (= n 1)
(cons d i)
(let ((q (quotient n 10))
(r (remainder n 10)))
(cond ((= r 0) (loop q d (+ i 1)))
((= r 5) (loop (quotient n 5) (* d 2) (+ i 1)))
((even? r) (loop (quotient n 2) (* d 5) (+ i 1)))
(else #f))))))
|