File: innum.scm

package info (click to toggle)
scsh 0.5.1-2
  • links: PTS
  • area: non-free
  • in suites: potato, slink
  • size: 6,540 kB
  • ctags: 8,656
  • sloc: lisp: 39,346; ansic: 13,466; sh: 1,669; makefile: 624
file content (108 lines) | stat: -rw-r--r-- 3,281 bytes parent folder | download
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
; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.


; 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)
  (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 &quotient 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))))))