/usr/share/scsh-0.6/rts/recnum.scm is in scsh-common-0.6 0.6.7-8.
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 111 112 113 114 115 116 117 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Rectangular complex arithmetic built on real arithmetic.
(define-extended-number-type :recnum (:complex)
(make-recnum real imag)
recnum?
(real recnum-real-part)
(imag recnum-imag-part))
(define (rectangulate x y) ; Assumes (eq? (exact? x) (exact? y))
(if (= y 0)
x
(make-recnum x y)))
(define (rectangular-real-part z)
(if (recnum? z)
(recnum-real-part z)
(real-part z)))
(define (rectangular-imag-part z)
(if (recnum? z)
(recnum-imag-part z)
(imag-part z)))
(define (rectangular+ a b)
(rectangulate (+ (rectangular-real-part a) (rectangular-real-part b))
(+ (rectangular-imag-part a) (rectangular-imag-part b))))
(define (rectangular- a b)
(rectangulate (- (rectangular-real-part a) (rectangular-real-part b))
(- (rectangular-imag-part a) (rectangular-imag-part b))))
(define (rectangular* a b)
(let ((a1 (rectangular-real-part a))
(a2 (rectangular-imag-part a))
(b1 (rectangular-real-part b))
(b2 (rectangular-imag-part b)))
(rectangulate (- (* a1 b1) (* a2 b2))
(+ (* a1 b2) (* a2 b1)))))
(define (rectangular/ a b)
(let ((a1 (rectangular-real-part a))
(a2 (rectangular-imag-part a))
(b1 (rectangular-real-part b))
(b2 (rectangular-imag-part b)))
(let ((d (+ (* b1 b1) (* b2 b2))))
(rectangulate (/ (+ (* a1 b1) (* a2 b2)) d)
(/ (- (* a2 b1) (* a1 b2)) d)))))
(define (rectangular= a b)
(let ((a1 (rectangular-real-part a))
(a2 (rectangular-imag-part a))
(b1 (rectangular-real-part b))
(b2 (rectangular-imag-part b)))
(and (= a1 b1) (= a2 b2))))
; Methods
(define-method &complex? ((z :recnum)) #t)
(define-method &real-part ((z :recnum)) (recnum-real-part z))
(define-method &imag-part ((z :recnum)) (recnum-imag-part z))
; Methods on complexes in terms of real-part and imag-part
(define-method &exact? ((z :recnum))
(exact? (recnum-real-part z)))
(define-method &inexact->exact ((z :recnum))
(make-recnum (inexact->exact (recnum-real-part z))
(inexact->exact (recnum-imag-part z))))
(define-method &exact->inexact ((z :recnum))
(make-recnum (exact->inexact (recnum-real-part z))
(exact->inexact (recnum-imag-part z))))
(define (define-recnum-method mtable proc)
(define-method mtable ((m :recnum) (n :complex)) (proc m n))
(define-method mtable ((m :complex) (n :recnum)) (proc m n)))
(define-recnum-method &+ rectangular+)
(define-recnum-method &- rectangular-)
(define-recnum-method &* rectangular*)
(define-recnum-method &/ rectangular/)
(define-recnum-method &= rectangular=)
(define-method &sqrt ((n :real))
(if (< n 0)
(make-rectangular 0 (sqrt (- 0 n)))
(next-method))) ; not that we have to
; Gleep! Can we do quotient and remainder on Gaussian integers?
; Can we do numerator and denominator on complex rationals?
(define-method &number->string ((z :recnum) radix)
(let ((x (real-part z))
(y (imag-part z)))
(let ((r (number->string x radix))
(i (number->string (abs y) radix))
(& (if (< y 0) "-" "+")))
(if (and (inexact? y) ;gross
(char=? (string-ref i 0) #\#))
(string-append (if (char=? (string-ref r 0) #\#)
""
"#i")
r &
(substring i 2 (string-length i))
"i")
(string-append r & i "i")))))
(define-method &make-rectangular ((x :real) (y :real))
(if (eq? (exact? x) (exact? y))
(rectangulate x y)
(rectangulate (if (exact? x) (exact->inexact x) x)
(if (exact? y) (exact->inexact y) y))))
|