lib/_num#.scm

   1 ;;;============================================================================
   2
   3 ;;; File: "_num#.scm", Time-stamp: <2008-10-30 16:53:55 feeley>
   4
   5 ;;; Copyright (c) 1994-2008 by Marc Feeley, All Rights Reserved.
   6
   7 ;;;============================================================================
   8
   9 ;;; Representation of exceptions.
  10
  11 (define-library-type-of-exception range-exception
  12   id: 10aa6857-6f27-45ab-ac38-2318ef2f277c
  13   constructor: #f
  14   opaque:
  15
  16   (procedure unprintable: read-only:)
  17   (arguments unprintable: read-only:)
  18   (arg-num   unprintable: read-only:)
  19 )
  20
  21 (define-library-type-of-exception divide-by-zero-exception
  22   id: c4319ec5-29d5-43f3-bd16-fad15b238e82
  23   constructor: #f
  24   opaque:
  25
  26   (procedure unprintable: read-only:)
  27   (arguments unprintable: read-only:)
  28 )
  29
  30 (define-library-type-of-exception fixnum-overflow-exception
  31   id: dd080472-485f-4f09-8e9e-924194042ff3
  32   constructor: #f
  33   opaque:
  34
  35   (procedure unprintable: read-only:)
  36   (arguments unprintable: read-only:)
  37 )
  38
  39 ;;;----------------------------------------------------------------------------
  40
  41 ;;; Define type checking macros.
  42
  43 (##define-macro (macro-index? var)
  44   `(##not (##fixnum.negative? ,var)))
  45
  46 (##define-macro (macro-index-range? var lo hi)
  47   `(macro-fixnum-range? ,var ,lo ,hi))
  48
  49 (##define-macro (macro-index-range-incl? var lo hi)
  50   `(macro-fixnum-range-incl? ,var ,lo ,hi))
  51
  52 (##define-macro (macro-fixnum-range? var lo hi)
  53   `(and (##not (##fixnum.< ,var ,lo))
  54         (##fixnum.< ,var ,hi)))
  55
  56 (##define-macro (macro-fixnum-range-incl? var lo hi)
  57   `(and (##not (##fixnum.< ,var ,lo))
  58         (##not (##fixnum.< ,hi ,var))))
  59
  60 (##define-macro (macro-fixnum-and-fixnum-range-incl? var lo hi)
  61   `(and (##fixnum? ,var)
  62         (macro-fixnum-range-incl? ,var ,lo ,hi)))
  63
  64 (##define-macro (macro-range-incl? var lo hi)
  65   `(and (macro-exact-int? ,var)
  66         (##not (##< ,var ,lo))
  67         (##not (##< ,hi ,var))))
  68
  69 (define-check-index-range-macro
  70   index
  71   macro-index?)
  72
  73 (define-check-index-range-macro
  74   index-range
  75   macro-index-range?
  76   lo
  77   hi)
  78
  79 (define-check-index-range-macro
  80   index-range-incl
  81   macro-index-range-incl?
  82   lo
  83   hi)
  84
  85 (define-check-index-range-macro
  86   fixnum-range
  87   macro-fixnum-range?
  88   lo
  89   hi)
  90
  91 (define-check-index-range-macro
  92   fixnum-range-incl
  93   macro-fixnum-range-incl?
  94   lo
  95   hi)
  96
  97 (define-check-type exact-signed-int8 'exact-signed-int8
  98   macro-fixnum-and-fixnum-range-incl?
  99   -128
 100   127)
 101
 102 (define-check-type exact-signed-int8-list 'exact-signed-int8-list
 103   macro-fixnum-and-fixnum-range-incl?
 104   -128
 105   127)
 106
 107 (define-check-type exact-unsigned-int8 'exact-unsigned-int8
 108   macro-fixnum-and-fixnum-range-incl?
 109   0
 110   255)
 111
 112 (define-check-type exact-unsigned-int8-list 'exact-unsigned-int8-list
 113   macro-fixnum-and-fixnum-range-incl?
 114   0
 115   255)
 116
 117 (define-check-type exact-signed-int16 'exact-signed-int16
 118   macro-fixnum-and-fixnum-range-incl?
 119   -32768
 120   32767)
 121
 122 (define-check-type exact-signed-int16-list 'exact-signed-int16-list
 123   macro-fixnum-and-fixnum-range-incl?
 124   -32768
 125   32767)
 126
 127 (define-check-type exact-unsigned-int16 'exact-unsigned-int16
 128   macro-fixnum-and-fixnum-range-incl?
 129   0
 130   65535)
 131
 132 (define-check-type exact-unsigned-int16-list 'exact-unsigned-int16-list
 133   macro-fixnum-and-fixnum-range-incl?
 134   0
 135   65535)
 136
 137 (define-check-type exact-signed-int32 'exact-signed-int32
 138   macro-range-incl?
 139   -2147483648
 140   2147483647)
 141
 142 (define-check-type exact-signed-int32-list 'exact-signed-int32-list
 143   macro-range-incl?
 144   -2147483648
 145   2147483647)
 146
 147 (define-check-type exact-unsigned-int32 'exact-unsigned-int32
 148   macro-range-incl?
 149   0
 150   4294967295)
 151
 152 (define-check-type exact-unsigned-int32-list 'exact-unsigned-int32-list
 153   macro-range-incl?
 154   0
 155   4294967295)
 156
 157 (define-check-type exact-signed-int64 'exact-signed-int64
 158   macro-range-incl?
 159   -9223372036854775808
 160   9223372036854775807)
 161
 162 (define-check-type exact-signed-int64-list 'exact-signed-int64-list
 163   macro-range-incl?
 164   -9223372036854775808
 165   9223372036854775807)
 166
 167 (define-check-type exact-unsigned-int64 'exact-unsigned-int64
 168   macro-range-incl?
 169   0
 170   18446744073709551615)
 171
 172 (define-check-type exact-unsigned-int64-list 'exact-unsigned-int64-list
 173   macro-range-incl?
 174   0
 175   18446744073709551615)
 176
 177 (define-check-type inexact-real 'inexact-real
 178   ##flonum?)
 179
 180 (define-check-type inexact-real-list 'inexact-real-list
 181   ##flonum?)
 182
 183 (define-check-type real 'real
 184   ##real?)
 185
 186 (define-check-type fixnum 'fixnum
 187   ##fixnum?)
 188
 189 (define-check-type flonum 'flonum
 190   ##flonum?)
 191
 192 ;;;============================================================================
 193
 194 ;;; Number representation.
 195
 196 ;; There are 5 internal representations for numbers:
 197 ;;
 198 ;; fixnum, bignum, ratnum, flonum, cpxnum
 199 ;;
 200 ;; Fixnums and bignums form the class of exact-int.
 201 ;; Fixnums, bignums and ratnums form the class of exact-real.
 202 ;; Fixnums, bignums, ratnums and flonums form the class of noncpxnum.
 203
 204 ;; The representation has some invariants:
 205 ;;
 206 ;; The numerator of a ratnum is a non-zero exact-int.
 207 ;; The denominator of a ratnum is an exact-int greater than 1.
 208 ;; The numerator and denominator have no common divisors greater than 1.
 209 ;;
 210 ;; The real part of a cpxnum is a noncpxnum.
 211 ;; The imaginary part of a cpxnum is a noncpxnum != fixnum 0
 212
 213 ;; The following table gives the mapping of the Scheme exact numbers to their
 214 ;; internal representation:
 215 ;;
 216 ;;    type          representation
 217 ;; exact integer  = exact-int (fixnum, bignum)
 218 ;; exact rational = exact-real (fixnum, bignum, ratnum)
 219 ;; exact real     = exact-real (fixnum, bignum, ratnum)
 220 ;; exact complex  = exact-real or cpxnum with exact-real real and imag parts
 221
 222 ;; For inexact numbers, the representation is not quite as straightforward.
 223 ;;
 224 ;; There are 3 special classes of inexact representation:
 225 ;; flonum-int : flonum with integer value
 226 ;; cpxnum-real: cpxnum with imag part = flonum 0.0 or -0.0
 227 ;; cpxnum-int : cpxnum-real with exact-int or flonum-int real part
 228 ;;
 229 ;; Note: cpxnum-real and cpxnum-int only exist if
 230 ;; (macro-cpxnum-are-possibly-real?) returns #t.
 231 ;;
 232 ;; This gives the following table for Scheme's inexact numbers:
 233 ;;
 234 ;;      type          representation
 235 ;; inexact integer  = flonum-int or cpxnum-int if it exists
 236 ;; inexact rational = flonum     or cpxnum-real if it exists
 237 ;; inexact real     = flonum     or cpxnum-real if it exists
 238 ;; inexact complex  = flonum     or cpxnum with flonum real or imag part
 239
 240 (##define-macro (macro-special-case-exact-zero?) #t); (+ -0. 0)=-0.  (* 4. 0)=0
 241 (##define-macro (macro-cpxnum-are-possibly-real?) #f)
 242
 243 (##define-macro (macro-exact-int? obj) ;; obj can be any object
 244   `(or (##fixnum? ,obj)
 245        (##bignum? ,obj)))
 246
 247 (##define-macro (macro-exact-real? obj) ;; obj can be any object
 248   `(or (macro-exact-int? ,obj)
 249        (##ratnum? ,obj)))
 250
 251 (##define-macro (macro-flonum-int? obj) ;; obj must be a flonum
 252   `(##flonum.integer? ,obj))
 253
 254 (##define-macro (macro-flonum-rational? obj) ;; obj must be a flonum
 255   `(##flonum.finite? ,obj))
 256
 257 (##define-macro (macro-noncpxnum-int? obj) ;; obj must be in fixnum/bignum/ratnum/flonum
 258   `(if (##flonum? ,obj)
 259      (macro-flonum-int? ,obj)
 260      (##not (##ratnum? ,obj))))
 261
 262 (##define-macro (macro-noncpxnum-rational? obj) ;; obj must be in fixnum/bignum/ratnum/flonum
 263   `(or (##not (##flonum? ,obj))
 264        (macro-flonum-rational? ,obj)))
 265
 266 (##define-macro (macro-cpxnum-int? obj) ;; obj must be a cpxnum
 267   `(and (macro-cpxnum-are-possibly-real?)
 268         (macro-cpxnum-real? ,obj)
 269         (let ((real (macro-cpxnum-real ,obj)))
 270           (macro-noncpxnum-int? real))))
 271
 272 (##define-macro (macro-cpxnum-rational? obj) ;; obj must be a cpxnum
 273   `(and (macro-cpxnum-are-possibly-real?)
 274         (let ((imag (macro-cpxnum-imag ,obj)))
 275           (and (##flonum? imag)
 276                (##flonum.zero? imag)
 277                (let ((real (macro-cpxnum-real ,obj)))
 278                  (macro-noncpxnum-rational? real))))))
 279
 280 (##define-macro (macro-cpxnum-real? obj) ;; obj must be a cpxnum
 281   `(and (macro-cpxnum-are-possibly-real?)
 282         (let ((imag (macro-cpxnum-imag ,obj)))
 283           (and (##flonum? imag)
 284                (##flonum.zero? imag)))))
 285
 286 ;; Dispatch for number representation
 287
 288 (##define-macro (macro-number-dispatch num err fix big rat flo cpx)
 289   `(cond ((##fixnum? ,num)                                 ,fix)
 290          ((##flonum? ,num)                                 ,flo)
 291          ((##subtyped? ,num)
 292           (let ((##s (##subtype ,num)))
 293             (cond ((##fixnum.= ##s (macro-subtype-bignum)) ,big)
 294                   ((##fixnum.= ##s (macro-subtype-ratnum)) ,rat)
 295                   ((##fixnum.= ##s (macro-subtype-cpxnum)) ,cpx)
 296                   (else                                    ,err))))
 297          (else                                             ,err)))
 298
 299 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 300
 301 ;;; Miscellaneous constants.
 302
 303 (##define-macro (macro-inexact-+2)     2.0)
 304 (##define-macro (macro-inexact--2)    -2.0)
 305 (##define-macro (macro-inexact-+1)     1.0)
 306 (##define-macro (macro-inexact--1)    -1.0)
 307 (##define-macro (macro-inexact-+1/2)   0.5)
 308 (##define-macro (macro-inexact-+0)     0.0)
 309 (##define-macro (macro-inexact--0)    -0.0)
 310 (##define-macro (macro-inexact-+pi)    3.141592653589793)
 311 (##define-macro (macro-inexact--pi)   -3.141592653589793)
 312 (##define-macro (macro-inexact-+pi/2)  1.5707963267948966)
 313 (##define-macro (macro-inexact--pi/2) -1.5707963267948966)
 314 (##define-macro (macro-inexact-+inf)  (/ +1. 0.))
 315 (##define-macro (macro-inexact--inf)  (/ -1. 0.))
 316 (##define-macro (macro-inexact-+nan)  (/ 0. 0.))
 317 (##define-macro (macro-cpxnum-+2i)    +2i)
 318 (##define-macro (macro-cpxnum--i)     -i)
 319 (##define-macro (macro-cpxnum-+i)     +i)
 320
 321 (##define-macro (macro-cpxnum-+1/2+sqrt3/2i)
 322   (make-rectangular 1/2 (/ (sqrt 3) 2)))
 323
 324 (##define-macro (macro-cpxnum-+1/2-sqrt3/2i)
 325   (make-rectangular 1/2 (- (/ (sqrt 3) 2))))
 326
 327 (##define-macro (macro-cpxnum--1/2+sqrt3/2i)
 328   (make-rectangular -1/2 (/ (sqrt 3) 2)))
 329
 330 (##define-macro (macro-cpxnum--1/2-sqrt3/2i)
 331   (make-rectangular -1/2 (- (/ (sqrt 3) 2))))
 332
 333 (##define-macro (macro-cpxnum-+sqrt3/2+1/2i)
 334   (make-rectangular (/ (sqrt 3) 2) 1/2))
 335
 336 (##define-macro (macro-cpxnum-+sqrt3/2-1/2i)
 337   (make-rectangular (/ (sqrt 3) 2) -1/2))
 338
 339 (##define-macro (macro-cpxnum--sqrt3/2+1/2i)
 340   (make-rectangular (- (/ (sqrt 3) 2)) 1/2))
 341
 342 (##define-macro (macro-cpxnum--sqrt3/2-1/2i)
 343   (make-rectangular (- (/ (sqrt 3) 2)) -1/2))
 344
 345 (##define-macro (macro-inexact-exp-+1/2) (exp +1/2))
 346 (##define-macro (macro-inexact-exp--1/2) (exp -1/2))
 347 (##define-macro (macro-inexact-log-2)    (log 2))
 348
 349 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 350
 351 ;;; Bignum related constants.
 352
 353 (##define-macro (macro-max-lines)                  65536)
 354 (##define-macro (macro-max-fixnum32-div-max-lines)  8191)
 355 (##define-macro (macro-max-fixnum32)           536870911)
 356 (##define-macro (macro-max-fixnum32-div-10)     53687091)
 357
 358 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 359
 360 ;;; Flonum related constants.
 361
 362 (##define-macro (macro-flonum-m-bits)
 363   52)
 364
 365 (##define-macro (macro-flonum-m-bits-plus-1)
 366   53)
 367
 368 (##define-macro (macro-flonum-m-bits-plus-1*2)
 369   106)
 370
 371 (##define-macro (macro-flonum-e-bits)
 372   11)
 373
 374 (##define-macro (macro-flonum-sign-bit) ;; (expt 2 (+ (macro-flonum-e-bits) (macro-flonum-m-bits)))
 375   #x8000000000000000)
 376
 377 (##define-macro (macro-flonum-m-min) ;; (expt 2.0 (macro-flonum-m-bits))
 378   4503599627370496.0)
 379
 380 (##define-macro (macro-flonum-+m-min) ;; (expt 2 (macro-flonum-m-bits))
 381   4503599627370496)
 382
 383 (##define-macro (macro-flonum-+m-max-plus-1) ;; (expt 2 (macro-flonum-m-bits-plus-1))
 384   9007199254740992)
 385
 386 (##define-macro (macro-flonum-+m-max) ;; (- (macro-flonum-+m-max-plus-1) 1)
 387   9007199254740991)
 388
 389 (##define-macro (macro-flonum-+m-max-plus-1-inexact);; (exact->inexact (macro-flonum-+m-max-plus-1))
 390   9007199254740992.0)
 391
 392 (##define-macro (macro-flonum-inverse-+m-max-plus-1-inexact);; (/ (macro-flonum-+m-max-plus-1-inexact))
 393   (/ 9007199254740992.0))
 394
 395 (##define-macro (macro-flonum--m-min) ;; (- (macro-flonum-+m-min))
 396   -4503599627370496)
 397
 398 (##define-macro (macro-flonum--m-max) ;; (- (macro-flonum-+m-max))
 399   -9007199254740991)
 400
 401 (##define-macro (macro-flonum-e-bias) ;; (- (expt 2 (- (macro-flonum-e-bits) 1)) 1)
 402   1023)
 403
 404 (##define-macro (macro-flonum-e-bias-plus-1) ;; (+ (macro-flonum-e-bias) 1)
 405   1024)
 406
 407 (##define-macro (macro-flonum-e-bias-minus-1) ;; (- (macro-flonum-e-bias) 1)
 408   1022)
 409
 410 (##define-macro (macro-flonum-e-min) ;; (- (+ (macro-flonum-e-bias) (macro-flonum-m-bits) -1))
 411   -1074)
 412
 413 (##define-macro (macro-flonum-min-normal) ;; (expt 2.0 (+ (macro-flonum-m-bits) (macro-flonum-e-min)))
 414   (expt 2.0 (+ 52 -1074)))
 415
 416 (##define-macro (macro-scale-down) ;; (expt 2 (- (+ (quotient (macro-flonum-e-bias-plus-1) 2) 1)))
 417   (expt 2 -513))
 418
 419 (##define-macro (macro-inexact-scale-down) ;; (expt 2.0 (- (+ (quotient (macro-flonum-e-bias-plus-1) 2) 1)))
 420   (expt 2.0 -513))
 421
 422 (##define-macro (macro-scale-up) ;; (expt 2 (+ (quotient (macro-flonum-e-bias-plus-1) 2) (macro-flonum-m-bits-plus-1)))
 423   (expt 2 565))
 424
 425 (##define-macro (macro-inexact-scale-up) ;; (expt 2.0 (+ (quotient (macro-flonum-e-bias-plus-1) 2) (macro-flonum-m-bits-plus-1)))
 426   (expt 2.0 565))
 427
 428 (##define-macro (macro-inexact-radix) ;; (exact->inexact (macro-radix))
 429   16384.0)
 430
 431 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 432
 433 ;;; Ratnum objects.
 434
 435 ;; A ratnum is represented by an object vector of length 2
 436 ;; slot 0 = numerator
 437 ;; slot 1 = denominator
 438
 439 (##define-macro (macro-ratnum-make num den)
 440   `(##subtype-set!
 441     (##vector ,num ,den)
 442     (macro-subtype-ratnum)))
 443
 444 (##define-macro (macro-ratnum-numerator r)          `(macro-slot 0 ,r))
 445 (##define-macro (macro-ratnum-numerator-set! r x)   `(macro-slot 0 ,r ,x))
 446 (##define-macro (macro-ratnum-denominator r)        `(macro-slot 1 ,r))
 447 (##define-macro (macro-ratnum-denominator-set! r x) `(macro-slot 1 ,r ,x))
 448
 449 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 450
 451 ;;; Cpxnum objects.
 452
 453 ;; A cpxnum is represented by an object vector of length 2
 454 ;; slot 0 = real
 455 ;; slot 1 = imag
 456
 457 (##define-macro (macro-cpxnum-make r i)
 458   `(##subtype-set!
 459     (##vector ,r ,i)
 460     (macro-subtype-cpxnum)))
 461
 462 (##define-macro (macro-cpxnum-real c)        `(macro-slot 0 ,c))
 463 (##define-macro (macro-cpxnum-real-set! c x) `(macro-slot 0 ,c ,x))
 464 (##define-macro (macro-cpxnum-imag c)        `(macro-slot 1 ,c))
 465 (##define-macro (macro-cpxnum-imag-set! c x) `(macro-slot 1 ,c ,x))
 466
 467 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 468
 469 (##define-macro (macro-bignum-odd? x);;;;;;;;;;;;;;;;;;;;
 470   `(##fixnum.odd? (##bignum.mdigit-ref ,x 0)))
 471
 472 (##define-macro (macro-real->inexact x)
 473   `(let ((x ,x))
 474      (if (##flonum? x)
 475        x
 476        (##exact->inexact
 477         (if (macro-cpxnum-are-possibly-real?)
 478           (##real-part x)
 479           x)))))
 480
 481 ;;;============================================================================