Changeset 8556 in project


Ignore:
Timestamp:
02/18/08 22:33:31 (12 years ago)
Author:
Kon Lovett
Message:

Bug fix for fixnum extras, flonum extras.

Location:
release/3/mathh
Files:
1 deleted
10 edited

Legend:

Unmodified
Added
Removed
  • release/3/mathh/tags/1.10/doc.scm

    r8544 r8556  
    224224        (usage "(require-extension fixnum-extras)")
    225225
     226        (procedure "(fixnum->string FX [RADIX])"
     227          (p "") )
     228
    226229        (procedure "(fixnum-width)"
    227230          (p "") )
     
    248251          (p "") )
    249252
     253        (procedure "(fxcompare FX1 FX2)"
     254          (p "") )
     255
    250256        (procedure "(fxzero? FX)"
    251257          (p "") )
     
    269275          (p "") )
    270276
     277        (procedure "(fxmax-and-minFX ...)"
     278          (p "") )
     279
     280        (procedure "(fxmodulo FX-N FX-D)"
     281          (p "") )
     282
     283        (procedure "(fxdiv FX-N FX-D)"
     284          (p "") )
     285
    271286        (procedure "(fxdiv-and-mod FX-N FX-D)"
    272287          (p "") )
    273288
     289        (procedure "(fxdiv0 FX-N FX-D)"
     290          (p "") )
     291
     292        (procedure "(fxmod0 FX-N FX-D)"
     293          (p "") )
     294
     295        (procedure "(fxdiv0-and-mod0 FX-N FX-D)"
     296          (p "") )
     297
     298        (procedure "(fx*/carry FX1 FX2 FX3)"
     299          (p "") )
     300
     301        (procedure "(fx+/carry FX1 FX2 FX3)"
     302          (p "") )
     303
     304        (procedure "(fx-/carry FX1 FX2 FX3)"
     305          (p "") )
     306
     307        (procedure "(fxadd1 FX)"
     308          (p "") )
     309
     310        (procedure "(fxsub1 FX)"
     311          (p "") )
     312
     313        (procedure "(fxquotient FX-N FX-D)"
     314          (p "") )
     315
     316        (procedure "(fxremainder FX-N FX-D)"
     317          (p "") )
     318
    274319        (procedure "(fxarithmetic-shift FX DIRECTIONAL-AMOUNT)"
    275320          (p "") )
     
    352397          (p "") )
    353398
     399        (procedure "(flcompare FL1 FL2)"
     400          (p "") )
     401
    354402        (procedure "(flinteger? FL)"
    355403          (p "") )
     
    397445          (p "") )
    398446
     447        (procedure "(flmax-and-min FL ...)"
     448          (p "") )
     449
    399450        (procedure "(flabs FL)"
    400451          (p "") )
     
    424475          (p "") )
    425476
     477        (procedure "(fldiv0 FL-N FL-D)"
     478          (p "") )
     479
     480        (procedure "(flmod0 FL-N FL-D)"
     481          (p "") )
     482
     483        (procedure "(fldiv0-and-mod0 FL-N FL-D)"
     484          (p "") )
     485
    426486        (procedure "(flexp FL)"
    427487          (p "") )
     
    452512
    453513        (procedure "(flexpt FL EXP)"
     514          (p "") )
     515
     516        (procedure "(flnumerator FL)"
     517          (p "") )
     518
     519        (procedure "(fldenominator FL)"
    454520          (p "") )
    455521      )
  • release/3/mathh/tags/1.10/fixnum-extras.scm

    r8547 r8556  
    77        (no-bound-checks)
    88        (no-procedure-checks-for-usual-bindings)
     9        (bound-to-procedure
     10          ##sys#signal-hook )
    911  (export
     12    fixnum->string
    1013    fixnum-width
    1114    least-fixnum
     
    1619    fx<=?
    1720    fx>=?
     21    fxcompare
    1822    fxzero?
    1923    fxpositive?
     
    2327    *fxmax
    2428    *fxmin
     29    fxmax-and-min
    2530    fxdiv
    2631    fxdiv-and-mod
     32    fxdiv0
     33    fxmod0
     34    fxdiv0-and-mod0
     35    fx*/carry
     36    fx+/carry
     37    fx-/carry
     38    fxadd1
     39    fxsub1
     40    fxmodulo
     41    fxquotient
     42    fxremainder
    2743    fxarithmetic-shift
    2844    fxarithmetic-shift-left
     
    4965;;;
    5066
     67(define-inline (fixnum-type-error loc obj)
     68  (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum" obj) )
     69
     70(define-inline (fixnum-zero-division-error loc fx1 fx2)
     71  (##sys#signal-hook #:arithmetic-error loc "division by zero" fx1 fx2) )
     72
     73(define-inline (fixnum-representation-error loc fx1 fx2)
     74  (##sys#signal-hook #:arithmetic-error loc "results not representable as fixnums" fx1 fx2) )
     75
    5176(define-inline (%fold1 func init lyst)
    5277  (let loop ([acc init] [lyst lyst])
     
    5580              (loop (func acc (car lyst)) (cdr lyst)) ) ) )
    5681
     82(define-inline (%and-fold1 func init lyst)
     83  (let loop ([prv init] [lyst lyst])
     84          (or (null? lyst)
     85              (and (func prv (car lyst))
     86             (loop (car lyst) (cdr lyst)) ) ) ) )
     87
     88(define-inline (%fxdiv0-and-mod0 fxn fxd)
     89  (let* ([quo (quotient fxn fxd)]
     90         [rem (- fxn (* quo fxd))])
     91    (cond [(>= fxd 0)
     92            (if (< (* rem 2) fxd)
     93                (if (<= (* rem -2) fxd)
     94                    (values quo rem)
     95                    (values (- quo 1) (+ rem fxd)) )
     96                (values (+ quo 1) (- rem fxd)) ) ]
     97          [(> (* rem -2) fxd)
     98            (if (>= (* rem 2) fxd)
     99                (values quo rem)
     100                (values (+ quo 1) (- rem fxd)) ) ]
     101          [else
     102            (values (- quo 1) (+ rem fxd)) ] ) ) )
     103
     104(define-inline (%fxdiv0 fxn fxd)
     105  (let* ([quo (quotient fxn fxd)]
     106         [rem (- fxn (* quo fxd))])
     107    (if (>= fxd 0)
     108        (if (< (* rem 2) fxd)
     109            (if (<= (* rem -2) fxd)
     110                quo
     111                (- quo 1) )
     112            (+ quo 1) )
     113        (if (> (* rem -2) fxd)
     114            (if (>= (* rem 2) fxd)
     115                quo
     116                (+ quo 1) )
     117            (- quo 1) ) ) ) )
     118
     119(define-inline (%fxmod0 fxn fxd)
     120  (let* ([quo (quotient fxn fxd)]
     121         [rem (- fxn (* quo fxd))])
     122    (cond [(>= fxd 0)
     123            (if (< (* rem 2) fxd)
     124                (if (<= (* rem -2) fxd)
     125                    rem
     126                    (+ rem fxd) )
     127                (- rem fxd) ) ]
     128          [(> (* rem -2) fxd)
     129            (if (>= (* rem 2) fxd)
     130                rem
     131                (- rem fxd) ) ]
     132          [else
     133            (+ rem fxd) ] ) ) )
     134
    57135;;;
    58136
     
    69147
    70148(define (fx=? fx . rest)
    71         (%fold1 fx= fx rest) )
     149        (%and-fold1 fx= fx rest) )
    72150
    73151(define (fx<? fx . rest)
    74         (%fold1 fx< fx rest) )
     152        (%and-fold1 fx< fx rest) )
    75153
    76154(define (fx>? fx . rest)
    77         (%fold1 fx> fx rest) )
     155        (%and-fold1 fx> fx rest) )
    78156
    79157(define (fx<=? fx . rest)
    80         (%fold1 fx<= fx rest) )
     158        (%and-fold1 fx<= fx rest) )
    81159
    82160(define (fx>=? fx . rest)
    83         (%fold1 fx>= fx rest) )
     161        (%and-fold1 fx>= fx rest) )
     162
     163(define (fxcompare fx1 fx2)
     164        (cond [(fx= fx1 fx2)  0]
     165              [(fx< fx1 fx2)  -1]
     166              [else           1] ) )
     167
     168(define (*fxmax fx . rest)
     169        (%fold1 max fx rest) )
     170
     171(define (*fxmin fx . rest)
     172        (%fold1 min fx rest) )
     173
     174(define (fxmax-and-min fx . rest)
     175        (let loop ([mx fx] [mn fx] [lyst rest])
     176          (if (null? lyst)
     177              (values mx mn)
     178              (let ([cur (car lyst)])
     179          (loop (fxmax mx cur) (fxmin mn cur) (cdr lyst)) ) ) ) )
    84180
    85181;;;
     
    102198;;;
    103199
    104 (define (*fxmax fx . rest)
    105         (%fold1 max fx rest) )
    106 
    107 (define (*fxmin fx . rest)
    108         (%fold1 min fx rest) )
    109 
    110200(define fxdiv fx/)
    111201
     
    113203        (values (fx/ fxn fxd) (fxmod fxn fxd)) )
    114204
    115 #|
     205(define (fxdiv0-and-mod0 fxn fxd)
     206  (if (fixnum? fxn)
     207      (if (fixnum? fxd)
     208          (if (fx= fxd 0)
     209              (fixnum-zero-division-error 'fxdiv0-and-mod0 fxn fxd)
     210              (let-values ([(d1 m1) (%fxdiv0-and-mod0 fxn fxd)])
     211                (if (and (fixnum? d1) (fixnum? m1))
     212                    (values d1 m1)
     213                    (fixnum-representation-error 'fxdiv0-and-mod0 fxn fxd) ) ) )
     214          (fixnum-type-error 'fxdiv0-and-mod0 fxd) )
     215      (fixnum-type-error 'fxdiv0-and-mod0 fxn) ) )
     216
     217(define (fxdiv0 fxn fxd)
     218  (if (fixnum? fxn)
     219      (if (fixnum? fxd)
     220          (if (fx= fxd 0)
     221              (fixnum-zero-division-error 'fxdiv0 fxn fxd)
     222              (let ([r (%fxdiv0 fxn fxd)])
     223                (if (fixnum? r)
     224                    r
     225                    (fixnum-representation-error 'fxdiv0 fxn fxd) ) ) )
     226          (fixnum-type-error 'fxdiv0 fxd) )
     227      (fixnum-type-error 'fxdiv0 fxn) ) )
     228
    116229(define (fxmod0 fxn fxd)
    117   (mod0 fxn fxd) )
    118 
    119 (define (fxdiv0 fxn fxd)
    120   (div0 fxn fxd) )
    121 
    122 (define (fxdiv0-and-mod0 fxn fxd)
    123   (values (fxdiv0 fxn fxd) (fxmod0 fxn fxd)) )
    124 
    125 (define fx+/carry)
    126 (define fx-/carry)
    127 (define fx*/carry)
    128 
    129 (let ([pow2w most-positive-machine-word #;(expt 2 fixnum-precision)])
    130 
    131   (set! fx+/carry
    132     (lambda (fx1 fx2 fx3)
    133       (let ([s (+ fx1 fx2 fx3)])
    134         (values (mod0 s pow2w) (div0 s pow2w)) ) ) )
    135 
    136   (set! fx-/carry
    137     (lambda (fx1 fx2 fx3)
    138       (let ([s (- fx1 fx2 fx3)])
    139         (values (mod0 s pow2w) (div0 s pow2w)) ) ) )
    140 
    141   (set! fx*/carry
    142     (lambda (+ (* fx1 fx2) fx3)
    143       (let ([s (+ fx1 fx2 fx3)])
    144         (values (mod0 s pow2w) (div0 s pow2w)) ) ) ) )
    145 |#
     230  (if (fixnum? fxn)
     231      (if (fixnum? fxd)
     232          (if (fx= fxd 0)
     233              (fixnum-zero-division-error 'fxmod0 fxn fxd)
     234              (let ([r (%fxmod0 fxn fxd)])
     235                (if (fixnum? r)
     236                    r
     237                    (fixnum-representation-error 'fxmod0 fxn fxd) ) ) )
     238          (fixnum-type-error 'fxmod0 fxd) )
     239      (fixnum-type-error 'fxmod0 fxn) ) )
     240
     241(define (fx*/carry fx1 fx2 fx3)
     242  (let ([s0 (fx+ (fx* fx1 fx2) fx3)])
     243    (values s0
     244            (arithmetic-shift (+ (* fx1 fx2) (- fx3 s0)) (- fixnum-precision)) ) ) )
     245
     246(define (fx+/carry fx1 fx2 fx3)
     247  (let ([s0 (fx+ (fx+ fx1 fx2) fx3)])
     248    (values s0
     249            (arithmetic-shift (+ (+ fx1 fx2) (- fx3 s0)) (- fixnum-precision)) ) ) )
     250
     251(define (fx-/carry fx1 fx2 fx3)
     252  (let ([s0 (fx- (fx- fx1 fx2) fx3)])
     253    (values s0
     254            (arithmetic-shift (- (- fx1 fx2) (+ s0 fx3)) (- fixnum-precision)) ) ) )
     255
     256(define (fxadd1 fx)
     257  (fx+ fx 1) )
     258
     259(define (fxsub1 fx)
     260  (fx- fx 1) )
     261
     262(define fxquotient fx/)
     263
     264(define (fxremainder fxn fxd)
     265  (fx- fxn (fx* (fx/ fxn fxd) fxd)) )
     266
     267(define fxmodulo fxmod)
    146268
    147269(define (fxarithmetic-shift fx amount)
     
    179301;;;
    180302
     303(define fixnum->string
     304  (let ([digits "0123456789ABCDEF"])
     305    (lambda (fx #!optional (radix 10))
     306      (letrec ([fx-digits
     307                 (lambda (fx from to)
     308                   (if (fx= 0 fx)
     309                       (values (make-string from) to)
     310                       (let* ([quo (fx/ fx radix)]
     311                              [digit (string-ref digits (fx- fx (fx* quo radix)))])
     312                           (let-values ([(str to) (fx-digits quo (fx+ from 1) to)])
     313                             (string-set! str to digit)
     314                             (values str (fx+ to 1)) ) ) ) ) ]
     315               [fx->str
     316                 (lambda (fx)
     317                   (cond [(fx= 0 fx)
     318                           (string #\0)]
     319                         [(fx> fx 0)
     320                           (fx-digits fx 0 0)]
     321                         [(fx= fx most-negative-fixnum)
     322                           (string-append (fx->str (fx/ fx radix))
     323                                          (fx->str (fx- radix (fxmod fx radix))))]
     324                         [else
     325                           (let ([str (fx-digits (fxneg fx) 1 1)])
     326                             (string-set! str 0 #\-)
     327                             str ) ] ) ) ] )
     328        (unless (fixnum? fx)
     329          (fixnum-type-error 'fixnum->string fx) )
     330        (case radix
     331          [(2 8 10 16)
     332            (fx->str fx)]
     333          [else
     334            (##sys#signal-hook #:type-error 'fixnum->string
     335                               "bad argument type - invalid radix" radix) ] ) ) ) ) )
     336
     337;;;
     338
    181339(define (fxif mask true false)
    182         (bitwise-if mask true false) )
     340        (%bitwise-if mask true false) )
    183341
    184342(define (fxbit-count fx)
    185         (bitwise-bit-count fx) )
     343        (%bitwise-bit-count fx) )
    186344
    187345(define (fxlength fx)
    188         (bitwise-length fx) )
     346        (%bitwise-length fx) )
    189347
    190348(define (fxfirst-bit-set fx)
    191         (bitwise-first-bit-set fx) )
     349        (%bitwise-first-bit-set fx) )
    192350
    193351(define (fxlast-bit-set fx)
    194         (bitwise-last-bit-set fx) )
     352        (%bitwise-last-bit-set fx) )
    195353
    196354(define (fxbit-set? fx index)
    197         (bitwise-bit-set? fx index) )
     355        (%bitwise-bit-set? fx index) )
    198356
    199357(define (fxcopy-bit fx index bit)
    200         (bitwise-copy-bit fx index bit) )
     358        (%bitwise-copy-bit fx index bit) )
    201359
    202360(define (fxbit-field fx start end)
    203         (bitwise-bit-field fx start end) )
     361        (%bitwise-bit-field fx start end) )
    204362
    205363(define (fxcopy-bit-field fxto start end fxfrom)
    206         (bitwise-copy-bit-field fxto start end fxfrom) )
     364        (%bitwise-copy-bit-field fxto start end fxfrom) )
    207365
    208366(define (fxrotate-bit-field fx start end count)
    209         (bitwise-rotate-bit-field fx start end count) )
     367        (%bitwise-rotate-bit-field fx start end count) )
    210368
    211369(define (fxreverse-bit-field fx start end)
    212         (bitwise-reverse-bit-field fx start end) )
    213 
     370        (%bitwise-reverse-bit-field fx start end) )
     371
  • release/3/mathh/tags/1.10/flonum-extras.scm

    r8547 r8556  
    1515    fl<=?
    1616    fl>=?
     17    flcompare
    1718    flinteger?
    1819    flzero?
     
    3031    flmax
    3132    flmin
     33    flmax-and-min
    3234    flabs
    3335    flfraction
     
    3941    flmod
    4042    fldiv-and-mod
     43    fldiv0
     44    flmod0
     45    fldiv0-and-mod0
    4146    flexp
    4247    fllog
     
    4954    flsqrt
    5055    flexpt
    51     #;flnumerator
    52     #;fldenominator ) )
     56    flnumerator
     57    fldenominator ) )
    5358
    5459(use mathh)
     
    6267              (loop (func acc (car lyst)) (cdr lyst)) ) ) )
    6368
    64 (define-inline (%fpfraction n)
    65   (##sys#flonum-fraction n) )
    66 
    67 (define-inline (%fptruncate n)
    68   (modf n) )
    69 
    70 (define-inline (%fpfloor n)
    71   (if (fp= 0.0 n)
     69(define-inline (%and-fold1 func init lyst)
     70  (let loop ([prv init] [lyst lyst])
     71          (or (null? lyst)
     72              (and (func prv (car lyst))
     73             (loop (car lyst) (cdr lyst)) ) ) ) )
     74
     75(define %fpfrac ##sys#flonum-fraction)
     76
     77(define %fptrunc modf)
     78
     79(define-inline (%fpfloor fp)
     80  (if (fp= 0.0 fp)
    7281      0.0
    73       (let ([nt (%fptruncate n)])
    74         (if (fp< 0.0 n)
     82      (let ([nt (%fptrunc fp)])
     83        (if (fp< 0.0 fp)
    7584            nt
    7685            (fp- nt 1.0) ) ) ) )
    7786
    78 (define-inline (%fpceiling n)
    79   (if (fp= 0.0 n)
     87(define-inline (%fpceil fp)
     88  (if (fp= 0.0 fp)
    8089      0.0
    81       (let ([nt (%fptruncate n)])
    82         (if (or (fp< 0.0 n) (not (fp= n nt)))
     90      (let ([nt (%fptrunc fp)])
     91        (if (or (fp< 0.0 fp) (not (fp= fp nt)))
    8392            (fp+ nt 1.0)
    8493            nt ) ) ) )
    8594
    86 (define-inline (%fpround x)
    87   (%fptruncate (if (fp< 0.0 x) (fp+ x 0.5) (fp- x 0.5))) )
    88 
    89 (define-inline (%fpremainder x y)
    90   (fp- x (fp* (fldiv x y) y)) )
     95(define-inline (%fprnd fp)
     96  (if (fp= 0.0 fp)
     97      0.0
     98      (%fptrunc (fp+ fp (if (fp< 0.0 fp) 0.5 -0.5))) ) )
     99
     100(define-inline (%fpquo fpn fpd)
     101  (%fptrunc (fp/ fpn fpd)) )
     102
     103(define-inline (%fprem fpn fpd)
     104  (fp- fpn (fp* (%fptrunc (fp/ fpn fpd)) fpd)) )
     105
     106(define-inline (%fpquo-and-rem fpn fpd)
     107  (let ([quo (%fpquo fpn fpd)])
     108    (values quo (fp- fpn (fp* quo fpd))) ) )
    91109
    92110(define-inline (%fp< x y)
    93   (or (and (fp= -0.0 x) (fp= 0.0 y))
     111  (or (and (fp= -0.0 x)
     112           (fp= 0.0 y))
    94113      (fp< x y) ) )
    95114
    96115(define-inline (%fp<= x y)
    97   (or (and (fp= -0.0 x) (fp= 0.0 y))
     116  (or (and (fp= -0.0 x)
     117           (fp= 0.0 y))
    98118      (fp<= x y) ) )
    99119
    100120(define-inline (%fp> x y)
    101   (or (and (fp= -0.0 y) (fp= 0.0 x))
     121  (or (and (fp= 0.0 x)
     122           (fp= -0.0 y))
    102123      (fp> x y) ) )
    103124
    104125(define-inline (%fp>= x y)
    105   (or (and (fp= -0.0 y) (fp= 0.0 x))
     126  (or (and (fp= 0.0 x)
     127           (fp= -0.0 y))
    106128      (fp>= x y) ) )
    107129
    108 (define-inline (%fpinteger? fl)
    109   (fp= 0.0 (%fpfraction fl)) )
    110 
    111 ;;;
    112 
    113 (define (real->flonum value)
    114   (exact->inexact value) )
    115 
    116 (define (fixnum->flonum value)
    117   (exact->inexact value) )
     130(define-inline (%fpinteger? fp)
     131  (fp= 0.0 (%fpfrac fp)) )
     132
     133(define (%fpnan? fp)
     134  (not (fp= fp fp)) )
     135
     136(define-inline (%fpdiv0-and-mod0 fpn fpd)
     137  (let-values ([(quo rem) (%fpquo-and-rem fpn fpd)])
     138    (cond [(fp>= fpd 0.0)
     139            (if (fp< rem (fp/ fpd 2.0))
     140                (if (fp>= rem (fp/ fpd -2.0))
     141                    (values quo rem)
     142                    (values (fp- quo 1.0) (fp+ rem fpd)) )
     143                (values (fp+ quo 1.0) (fp- rem fpd)) ) ]
     144          [(fp< rem (fp/ fpd -2.0))
     145            (if (fp>= rem (fp/ fpd 2.0))
     146                (values quo rem)
     147                (values (fp+ quo 1.0) (fp- rem fpd)) ) ]
     148          [else
     149            (values (fp- quo 1.0) (fp+ rem fpd)) ] ) ) )
     150
     151(define-inline (%fpdiv0 fpn fpd)
     152  (let-values ([(quo rem) (%fpquo-and-rem fpn fpd)])
     153    (cond [(fp>= fpd 0.0)
     154            (if (fp< rem (fp/ fpd 2.0))
     155                (if (fp>= rem (fp/ fpd -2.0))
     156                    quo
     157                    (fp- quo 1.0) )
     158                (fp+ quo 1.0) ) ]
     159          [(fp< rem (fp/ fpd -2.0))
     160            (if (fp>= rem (fp/ fpd 2.0))
     161                quo
     162                (fp+ quo 1.0) ) ]
     163          [else
     164            (fp- quo 1.0) ] ) ) )
     165
     166(define-inline (%fpmod0 fpn fpd)
     167  (let ([rem (%fprem fpn fpd)])
     168    (cond [(fp>= fpd 0.0)
     169            (if (fp< rem (fp/ fpd 2.0))
     170                (if (fp>= rem (fp/ fpd -2.0))
     171                    rem
     172                    (fp+ rem fpd) )
     173                (fp- rem fpd) ) ]
     174          [(fp< rem (fp/ fpd -2.0))
     175            (if (fp>= rem (fp/ fpd 2.0))
     176                rem
     177                (fp- rem fpd) )]
     178          [else
     179            (fp+ rem fpd) ] ) ) )
     180
     181;;;
     182
     183(define real->flonum
     184  (let ([exact->inexact exact->inexact])
     185    (lambda (value)
     186      (if (flonum? value)
     187          value
     188          (exact->inexact value) ) ) ) )
     189
     190(define fixnum->flonum
     191  (let ([exact->inexact exact->inexact])
     192    (lambda (fx)
     193      (unless (fixnum? fx)
     194        (##sys#signal-hook #:type-error 'fixnum->flonum
     195                           "bad argument type - not a fixnum" fx) )
     196      (exact->inexact fx) ) ) )
    118197
    119198;;;
    120199
    121200(define (fl=? fl . rest)
    122         (%fold1 fp= fl rest) )
     201        (%and-fold1 fp= fl rest) )
    123202
    124203(define (fl<? fl . rest)
    125         (let loop ([fl fl] [rest rest])
    126           (or (null? rest)
    127               (let ([fl1 (car rest)])
    128           (and (%fp< fl fl1)
    129                (loop fl1 (cdr rest)) ) ) ) ) )
     204        (%and-fold1 %fp< fl rest) )
    130205
    131206(define (fl>? fl . rest)
    132         (let loop ([fl fl] [rest rest])
    133           (or (null? rest)
    134               (let ([fl1 (car rest)])
    135           (and (%fp> fl fl1)
    136                (loop fl1 (cdr rest)) ) ) ) ) )
     207        (%and-fold1 %fp> fl rest) )
    137208
    138209(define (fl<=? fl . rest)
    139         (let loop ([fl fl] [rest rest])
    140           (or (null? rest)
    141               (let ([fl1 (car rest)])
    142           (and (%fp<= fl fl1)
    143                (loop fl1 (cdr rest)) ) ) ) ) )
     210        (%and-fold1 %fp<= fl rest) )
    144211
    145212(define (fl>=? fl . rest)
    146         (let loop ([fl fl] [rest rest])
    147           (or (null? rest)
    148               (let ([fl1 (car rest)])
    149           (and (%fp>= fl fl1)
    150                (loop fl1 (cdr rest)) ) ) ) ) )
     213        (%and-fold1 %fp>= fl rest) )
     214
     215(define (flcompare fl1 fl2)
     216        (cond [(fp= fl1 fl2)
     217                (cond [(fp= -0.0 fl1)
     218                  (if (fp= -0.0 fl1) 0 1) ]
     219                      [(fp= -0.0 fl2)
     220                        (if (fp= 0.0 fl1) -1 0) ]
     221                      [else
     222                        0 ] ) ]
     223              [(fp< fl1 fl2)
     224                -1 ]
     225              [else
     226                1 ] ) )
     227
     228(define (flmax fl . rest)
     229        (%fold1 fpmax fl rest) )
     230
     231(define (flmin fl . rest)
     232        (%fold1 fpmin fl rest) )
     233
     234(define (flmax-and-min fl . rest)
     235        (let loop ([mx fl] [mn fl] [lyst rest])
     236          (if (null? lyst)
     237              (values mx mn)
     238              (let ([cur (car lyst)])
     239          (loop (fpmax mx cur) (fpmin mn cur) (cdr lyst)) ) ) ) )
    151240
    152241;;;
     
    162251
    163252(define (flnegative? fl)
    164         (and (not (fp= -0.0 fl))
    165        (fp< fl 0.0) ) )
     253        (or (fp= -0.0 fl)
     254      (fp< fl 0.0) ) )
    166255
    167256(define (flodd? fl)
    168   (and (%fpinteger? fl)
    169        (not (fp= 0.0 (%fpfraction (fp/ fl 2.0)))) ) )
     257  (fx= 1 (bitwise-and (%fptrunc fl) #b1)) )
    170258
    171259(define (fleven? fl)
    172   (and (%fpinteger? fl)
    173        (fp= 0.0 (%fpfraction (fp/ fl 2.0))) ) )
     260  (fx= 0 (bitwise-and (%fptrunc fl) #b1)) )
    174261
    175262(define (flfinite? fl)
     
    180267
    181268(define (flnan? fl)
    182   (not (fp= fl fl)) )
     269  (%fpnan? fl) )
    183270
    184271;;;
     
    198285  (or (and (null? rest)
    199286           (fp/ 1.0 fl) )
    200         (%fold1 fp+ fl rest) ) )
    201 
    202 (define (flmax fl . rest)
    203         (%fold1 fpmax fl rest) )
    204 
    205 (define (flmin fl . rest)
    206         (%fold1 fpmin fl rest) )
     287        (%fold1 fp/ fl rest) ) )
    207288
    208289(define (flabs fl)
    209   (if (fp< fl 0.0)
    210       (fpneg fl)
    211       fl ) )
     290  (cond [(fp= -0.0 fl)  0.0]
     291        [(fp< fl 0.0)   (fpneg fl)]
     292        [else           fl] ) )
    212293
    213294(define (flfraction fl)
    214   (%fpfraction fl) )
     295  (%fpfrac fl) )
    215296
    216297(define (fltruncate fl)
    217   (%fptruncate fl) )
     298  (%fptrunc fl) )
    218299
    219300(define (flfloor fl)
     
    221302
    222303(define (flceiling fl)
    223   (%fpceiling fl) )
     304  (%fpceil fl) )
    224305
    225306(define (flround fl)
    226   (%fpround fl) )
     307  (%fprnd fl) )
    227308
    228309(define (fldiv fln fld)
    229   (%fptruncate (fp/ fln fld)) )
     310  (%fpquo fln fld) )
    230311
    231312(define (flmod fln fld)
    232   (fpmod fln fld) )
     313  (%fprem fln fld) )
    233314
    234315(define (fldiv-and-mod fln fld)
    235         (values (fp/ fln fld) (flmod fln fld)) )
    236 
    237 #|
     316  (%fpquo-and-rem fln fld) )
     317
     318(define (fldiv0 fln fld)
     319  (%fpdiv0 fln fld) )
     320
    238321(define (flmod0 fln fld)
    239   (mod0 fln fld) )
    240 
    241 (define (fldiv0 fln fld)
    242   (div0 fln fld) )
     322  (%fpmod0 fln fld) )
    243323
    244324(define (fldiv0-and-mod0 fln fld)
    245   (values (fldiv0 fln fld) (flmod0 fln fld)) )
    246 |#
    247 
    248 (define (flexp fl)
    249         (exp fl) )
    250 
    251 (define (fllog fl #!optional base)
    252   (or (and base
    253            ((make-log/base base) fl) )
    254       #;
    255       (and (VERY-SMALL fl)
    256            (log1p (fp- fl 1.0)) )
    257       (log fl) ) )
    258 
    259 (define (flsin fl)
    260         (sin fl) )
    261 
    262 (define (flcos fl)
    263         (cos fl) )
    264 
    265 (define (fltan fl)
    266         (tan fl) )
    267 
    268 (define (flasin fl)
    269         (asin fl) )
    270 
    271 (define (flacos fl)
    272         (acos fl) )
    273 
    274 (define (flatan fl #!optional fld)
    275   (or (and fld
    276            (atan (fp/ fl fld)) )
    277             (atan fl) ) )
    278 
    279 (define (flsqrt fl)
    280   (sqrt fl) )
    281 
    282 (define (flexpt fl exp)
    283         (or (and (= 2.0 fl)
    284            (ldexp 1.0 exp) )
    285       (expt fl exp) ) )
    286 
    287 #;
     325  (%fpdiv0-and-mod0 fln fld) )
     326
     327(define flexp
     328  (let ([exp exp])
     329    (lambda (fl)
     330      (exp fl) ) ) )
     331
     332(define fllog
     333  (let ([log log])
     334    (lambda (fl #!optional base)
     335      (or (and base
     336               ((make-log/base base) fl) )
     337          #;
     338          (and (VERY-SMALL-FLONUM? fl)
     339               (log1p (fp- fl 1.0)) )
     340          (log fl) ) ) ) )
     341
     342(define flsin
     343        (let ([sin sin])
     344                (lambda (fl)
     345                        (sin fl) ) ) )
     346
     347(define flcos
     348        (let ([cos cos])
     349                (lambda (fl)
     350                        (cos fl) ) ) )
     351
     352(define fltan
     353        (let ([tan tan])
     354                (lambda (fl)
     355                        (tan fl) ) ) )
     356
     357(define flasin
     358        (let ([asin asin])
     359                (lambda (fl)
     360                        (asin fl) ) ) )
     361
     362(define flacos
     363        (let ([acos acos])
     364                (lambda (fl)
     365                        (acos fl) ) ) )
     366
     367(define flatan
     368  (let ([atan atan])
     369    (lambda (fl #!optional fld)
     370      (or (and fld
     371               (atan (fp/ fl fld)) )
     372          (atan fl) ) ) ) )
     373
     374(define flsqrt
     375  (let ([sqrt sqrt])
     376    (lambda (fl)
     377      (sqrt fl) ) ) )
     378
     379(define flexpt
     380  (let ([expt expt])
     381    (lambda (fl exp)
     382      (or (and (= 2.0 fl)
     383               (ldexp 1.0 exp) )
     384          (expt fl exp) ) ) ) )
     385
    288386(define (flnumerator fl)
    289   (or (and (fx= -0.0 fl)
    290            -0.0 )
    291       XXX ) )
    292 
    293 #;
     387  fl )
     388
    294389(define (fldenominator fl)
    295   (or (and (fx= 0.0 fl)
    296            1.0 )
    297       XXX ) )
    298 
     390  (if (%fpnan? fl)
     391      fl
     392      1.0 ) )
  • release/3/mathh/tags/1.10/mathh.html

    r8544 r8556  
    579579<div class="section">
    580580<h3>Usage</h3>(require-extension fixnum-extras)</div>
     581<dt class="definition"><strong>procedure:</strong> (fixnum-&gt;string FX [RADIX])</dt>
     582<dd>
     583<p></p></dd>
    581584<dt class="definition"><strong>procedure:</strong> (fixnum-width)</dt>
    582585<dd>
     
    603606<dd>
    604607<p></p></dd>
     608<dt class="definition"><strong>procedure:</strong> (fxcompare FX1 FX2)</dt>
     609<dd>
     610<p></p></dd>
    605611<dt class="definition"><strong>procedure:</strong> (fxzero? FX)</dt>
    606612<dd>
     
    624630<dd>
    625631<p></p></dd>
     632<dt class="definition"><strong>procedure:</strong> (fxmax-and-minFX ...)</dt>
     633<dd>
     634<p></p></dd>
     635<dt class="definition"><strong>procedure:</strong> (fxmodulo FX-N FX-D)</dt>
     636<dd>
     637<p></p></dd>
     638<dt class="definition"><strong>procedure:</strong> (fxdiv FX-N FX-D)</dt>
     639<dd>
     640<p></p></dd>
    626641<dt class="definition"><strong>procedure:</strong> (fxdiv-and-mod FX-N FX-D)</dt>
     642<dd>
     643<p></p></dd>
     644<dt class="definition"><strong>procedure:</strong> (fxdiv0 FX-N FX-D)</dt>
     645<dd>
     646<p></p></dd>
     647<dt class="definition"><strong>procedure:</strong> (fxmod0 FX-N FX-D)</dt>
     648<dd>
     649<p></p></dd>
     650<dt class="definition"><strong>procedure:</strong> (fxdiv0-and-mod0 FX-N FX-D)</dt>
     651<dd>
     652<p></p></dd>
     653<dt class="definition"><strong>procedure:</strong> (fx*/carry FX1 FX2 FX3)</dt>
     654<dd>
     655<p></p></dd>
     656<dt class="definition"><strong>procedure:</strong> (fx+/carry FX1 FX2 FX3)</dt>
     657<dd>
     658<p></p></dd>
     659<dt class="definition"><strong>procedure:</strong> (fx-/carry FX1 FX2 FX3)</dt>
     660<dd>
     661<p></p></dd>
     662<dt class="definition"><strong>procedure:</strong> (fxadd1 FX)</dt>
     663<dd>
     664<p></p></dd>
     665<dt class="definition"><strong>procedure:</strong> (fxsub1 FX)</dt>
     666<dd>
     667<p></p></dd>
     668<dt class="definition"><strong>procedure:</strong> (fxquotient FX-N FX-D)</dt>
     669<dd>
     670<p></p></dd>
     671<dt class="definition"><strong>procedure:</strong> (fxremainder FX-N FX-D)</dt>
    627672<dd>
    628673<p></p></dd>
     
    706751<dd>
    707752<p></p></dd>
     753<dt class="definition"><strong>procedure:</strong> (flcompare FL1 FL2)</dt>
     754<dd>
     755<p></p></dd>
    708756<dt class="definition"><strong>procedure:</strong> (flinteger? FL)</dt>
    709757<dd>
     
    751799<dd>
    752800<p></p></dd>
     801<dt class="definition"><strong>procedure:</strong> (flmax-and-min FL ...)</dt>
     802<dd>
     803<p></p></dd>
    753804<dt class="definition"><strong>procedure:</strong> (flabs FL)</dt>
    754805<dd>
     
    778829<dd>
    779830<p></p></dd>
     831<dt class="definition"><strong>procedure:</strong> (fldiv0 FL-N FL-D)</dt>
     832<dd>
     833<p></p></dd>
     834<dt class="definition"><strong>procedure:</strong> (flmod0 FL-N FL-D)</dt>
     835<dd>
     836<p></p></dd>
     837<dt class="definition"><strong>procedure:</strong> (fldiv0-and-mod0 FL-N FL-D)</dt>
     838<dd>
     839<p></p></dd>
    780840<dt class="definition"><strong>procedure:</strong> (flexp FL)</dt>
    781841<dd>
     
    806866<p></p></dd>
    807867<dt class="definition"><strong>procedure:</strong> (flexpt FL EXP)</dt>
     868<dd>
     869<p></p></dd>
     870<dt class="definition"><strong>procedure:</strong> (flnumerator FL)</dt>
     871<dd>
     872<p></p></dd>
     873<dt class="definition"><strong>procedure:</strong> (fldenominator FL)</dt>
    808874<dd>
    809875<p></p></dd></div>
  • release/3/mathh/tags/1.10/tests/mathh-test.scm

    r8512 r8556  
    44(use testbase testbase-output-human)
    55(use mathh mathh-int mathh-float mathh-fpclass)
    6 #;
    76(use fixnum-extras)
     7(use flonum-extras)
    88(use bitwise-extras)
    99
     
    7171#;
    7272(define-test mathh-fixnum-test "Fixnum Functions"
     73)
     74
     75#;
     76(define-test mathh-flonum-test "Flonum Functions"
    7377)
    7478
  • release/3/mathh/trunk/doc.scm

    r8544 r8556  
    224224        (usage "(require-extension fixnum-extras)")
    225225
     226        (procedure "(fixnum->string FX [RADIX])"
     227          (p "") )
     228
    226229        (procedure "(fixnum-width)"
    227230          (p "") )
     
    248251          (p "") )
    249252
     253        (procedure "(fxcompare FX1 FX2)"
     254          (p "") )
     255
    250256        (procedure "(fxzero? FX)"
    251257          (p "") )
     
    269275          (p "") )
    270276
     277        (procedure "(fxmax-and-minFX ...)"
     278          (p "") )
     279
     280        (procedure "(fxmodulo FX-N FX-D)"
     281          (p "") )
     282
     283        (procedure "(fxdiv FX-N FX-D)"
     284          (p "") )
     285
    271286        (procedure "(fxdiv-and-mod FX-N FX-D)"
    272287          (p "") )
    273288
     289        (procedure "(fxdiv0 FX-N FX-D)"
     290          (p "") )
     291
     292        (procedure "(fxmod0 FX-N FX-D)"
     293          (p "") )
     294
     295        (procedure "(fxdiv0-and-mod0 FX-N FX-D)"
     296          (p "") )
     297
     298        (procedure "(fx*/carry FX1 FX2 FX3)"
     299          (p "") )
     300
     301        (procedure "(fx+/carry FX1 FX2 FX3)"
     302          (p "") )
     303
     304        (procedure "(fx-/carry FX1 FX2 FX3)"
     305          (p "") )
     306
     307        (procedure "(fxadd1 FX)"
     308          (p "") )
     309
     310        (procedure "(fxsub1 FX)"
     311          (p "") )
     312
     313        (procedure "(fxquotient FX-N FX-D)"
     314          (p "") )
     315
     316        (procedure "(fxremainder FX-N FX-D)"
     317          (p "") )
     318
    274319        (procedure "(fxarithmetic-shift FX DIRECTIONAL-AMOUNT)"
    275320          (p "") )
     
    352397          (p "") )
    353398
     399        (procedure "(flcompare FL1 FL2)"
     400          (p "") )
     401
    354402        (procedure "(flinteger? FL)"
    355403          (p "") )
     
    397445          (p "") )
    398446
     447        (procedure "(flmax-and-min FL ...)"
     448          (p "") )
     449
    399450        (procedure "(flabs FL)"
    400451          (p "") )
     
    424475          (p "") )
    425476
     477        (procedure "(fldiv0 FL-N FL-D)"
     478          (p "") )
     479
     480        (procedure "(flmod0 FL-N FL-D)"
     481          (p "") )
     482
     483        (procedure "(fldiv0-and-mod0 FL-N FL-D)"
     484          (p "") )
     485
    426486        (procedure "(flexp FL)"
    427487          (p "") )
     
    452512
    453513        (procedure "(flexpt FL EXP)"
     514          (p "") )
     515
     516        (procedure "(flnumerator FL)"
     517          (p "") )
     518
     519        (procedure "(fldenominator FL)"
    454520          (p "") )
    455521      )
  • release/3/mathh/trunk/fixnum-extras.scm

    r8544 r8556  
    77        (no-bound-checks)
    88        (no-procedure-checks-for-usual-bindings)
     9        (bound-to-procedure
     10          ##sys#signal-hook )
    911  (export
     12    fixnum->string
    1013    fixnum-width
    1114    least-fixnum
     
    1619    fx<=?
    1720    fx>=?
     21    fxcompare
    1822    fxzero?
    1923    fxpositive?
     
    2327    *fxmax
    2428    *fxmin
     29    fxmax-and-min
    2530    fxdiv
    2631    fxdiv-and-mod
     32    fxdiv0
     33    fxmod0
     34    fxdiv0-and-mod0
     35    fx*/carry
     36    fx+/carry
     37    fx-/carry
     38    fxadd1
     39    fxsub1
     40    fxmodulo
     41    fxquotient
     42    fxremainder
    2743    fxarithmetic-shift
    2844    fxarithmetic-shift-left
     
    4965;;;
    5066
     67(define-inline (fixnum-type-error loc obj)
     68  (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum" obj) )
     69
     70(define-inline (fixnum-zero-division-error loc fx1 fx2)
     71  (##sys#signal-hook #:arithmetic-error loc "division by zero" fx1 fx2) )
     72
     73(define-inline (fixnum-representation-error loc fx1 fx2)
     74  (##sys#signal-hook #:arithmetic-error loc "results not representable as fixnums" fx1 fx2) )
     75
    5176(define-inline (%fold1 func init lyst)
    5277  (let loop ([acc init] [lyst lyst])
     
    5580              (loop (func acc (car lyst)) (cdr lyst)) ) ) )
    5681
     82(define-inline (%and-fold1 func init lyst)
     83  (let loop ([prv init] [lyst lyst])
     84          (or (null? lyst)
     85              (and (func prv (car lyst))
     86             (loop (car lyst) (cdr lyst)) ) ) ) )
     87
     88(define-inline (%fxdiv0-and-mod0 fxn fxd)
     89  (let* ([quo (quotient fxn fxd)]
     90         [rem (- fxn (* quo fxd))])
     91    (cond [(>= fxd 0)
     92            (if (< (* rem 2) fxd)
     93                (if (<= (* rem -2) fxd)
     94                    (values quo rem)
     95                    (values (- quo 1) (+ rem fxd)) )
     96                (values (+ quo 1) (- rem fxd)) ) ]
     97          [(> (* rem -2) fxd)
     98            (if (>= (* rem 2) fxd)
     99                (values quo rem)
     100                (values (+ quo 1) (- rem fxd)) ) ]
     101          [else
     102            (values (- quo 1) (+ rem fxd)) ] ) ) )
     103
     104(define-inline (%fxdiv0 fxn fxd)
     105  (let* ([quo (quotient fxn fxd)]
     106         [rem (- fxn (* quo fxd))])
     107    (if (>= fxd 0)
     108        (if (< (* rem 2) fxd)
     109            (if (<= (* rem -2) fxd)
     110                quo
     111                (- quo 1) )
     112            (+ quo 1) )
     113        (if (> (* rem -2) fxd)
     114            (if (>= (* rem 2) fxd)
     115                quo
     116                (+ quo 1) )
     117            (- quo 1) ) ) ) )
     118
     119(define-inline (%fxmod0 fxn fxd)
     120  (let* ([quo (quotient fxn fxd)]
     121         [rem (- fxn (* quo fxd))])
     122    (cond [(>= fxd 0)
     123            (if (< (* rem 2) fxd)
     124                (if (<= (* rem -2) fxd)
     125                    rem
     126                    (+ rem fxd) )
     127                (- rem fxd) ) ]
     128          [(> (* rem -2) fxd)
     129            (if (>= (* rem 2) fxd)
     130                rem
     131                (- rem fxd) ) ]
     132          [else
     133            (+ rem fxd) ] ) ) )
     134
    57135;;;
    58136
     
    69147
    70148(define (fx=? fx . rest)
    71         (%fold1 fx= fx rest) )
     149        (%and-fold1 fx= fx rest) )
    72150
    73151(define (fx<? fx . rest)
    74         (%fold1 fx< fx rest) )
     152        (%and-fold1 fx< fx rest) )
    75153
    76154(define (fx>? fx . rest)
    77         (%fold1 fx> fx rest) )
     155        (%and-fold1 fx> fx rest) )
    78156
    79157(define (fx<=? fx . rest)
    80         (%fold1 fx<= fx rest) )
     158        (%and-fold1 fx<= fx rest) )
    81159
    82160(define (fx>=? fx . rest)
    83         (%fold1 fx>= fx rest) )
     161        (%and-fold1 fx>= fx rest) )
     162
     163(define (fxcompare fx1 fx2)
     164        (cond [(fx= fx1 fx2)  0]
     165              [(fx< fx1 fx2)  -1]
     166              [else           1] ) )
     167
     168(define (*fxmax fx . rest)
     169        (%fold1 max fx rest) )
     170
     171(define (*fxmin fx . rest)
     172        (%fold1 min fx rest) )
     173
     174(define (fxmax-and-min fx . rest)
     175        (let loop ([mx fx] [mn fx] [lyst rest])
     176          (if (null? lyst)
     177              (values mx mn)
     178              (let ([cur (car lyst)])
     179          (loop (fxmax mx cur) (fxmin mn cur) (cdr lyst)) ) ) ) )
    84180
    85181;;;
     
    102198;;;
    103199
    104 (define (*fxmax fx . rest)
    105         (%fold1 max fx rest) )
    106 
    107 (define (*fxmin fx . rest)
    108         (%fold1 min fx rest) )
    109 
    110200(define fxdiv fx/)
    111201
     
    113203        (values (fx/ fxn fxd) (fxmod fxn fxd)) )
    114204
    115 #|
     205(define (fxdiv0-and-mod0 fxn fxd)
     206  (if (fixnum? fxn)
     207      (if (fixnum? fxd)
     208          (if (fx= fxd 0)
     209              (fixnum-zero-division-error 'fxdiv0-and-mod0 fxn fxd)
     210              (let-values ([(d1 m1) (%fxdiv0-and-mod0 fxn fxd)])
     211                (if (and (fixnum? d1) (fixnum? m1))
     212                    (values d1 m1)
     213                    (fixnum-representation-error 'fxdiv0-and-mod0 fxn fxd) ) ) )
     214          (fixnum-type-error 'fxdiv0-and-mod0 fxd) )
     215      (fixnum-type-error 'fxdiv0-and-mod0 fxn) ) )
     216
     217(define (fxdiv0 fxn fxd)
     218  (if (fixnum? fxn)
     219      (if (fixnum? fxd)
     220          (if (fx= fxd 0)
     221              (fixnum-zero-division-error 'fxdiv0 fxn fxd)
     222              (let ([r (%fxdiv0 fxn fxd)])
     223                (if (fixnum? r)
     224                    r
     225                    (fixnum-representation-error 'fxdiv0 fxn fxd) ) ) )
     226          (fixnum-type-error 'fxdiv0 fxd) )
     227      (fixnum-type-error 'fxdiv0 fxn) ) )
     228
    116229(define (fxmod0 fxn fxd)
    117   (mod0 fxn fxd) )
    118 
    119 (define (fxdiv0 fxn fxd)
    120   (div0 fxn fxd) )
    121 
    122 (define (fxdiv0-and-mod0 fxn fxd)
    123   (values (fxdiv0 fxn fxd) (fxmod0 fxn fxd)) )
    124 
    125 (define fx+/carry)
    126 (define fx-/carry)
    127 (define fx*/carry)
    128 
    129 (let ([pow2w most-positive-machine-word #;(expt 2 fixnum-precision)])
    130 
    131   (set! fx+/carry
    132     (lambda (fx1 fx2 fx3)
    133       (let ([s (+ fx1 fx2 fx3)])
    134         (values (mod0 s pow2w) (div0 s pow2w)) ) ) )
    135 
    136   (set! fx-/carry
    137     (lambda (fx1 fx2 fx3)
    138       (let ([s (- fx1 fx2 fx3)])
    139         (values (mod0 s pow2w) (div0 s pow2w)) ) ) )
    140 
    141   (set! fx*/carry
    142     (lambda (+ (* fx1 fx2) fx3)
    143       (let ([s (+ fx1 fx2 fx3)])
    144         (values (mod0 s pow2w) (div0 s pow2w)) ) ) ) )
    145 |#
     230  (if (fixnum? fxn)
     231      (if (fixnum? fxd)
     232          (if (fx= fxd 0)
     233              (fixnum-zero-division-error 'fxmod0 fxn fxd)
     234              (let ([r (%fxmod0 fxn fxd)])
     235                (if (fixnum? r)
     236                    r
     237                    (fixnum-representation-error 'fxmod0 fxn fxd) ) ) )
     238          (fixnum-type-error 'fxmod0 fxd) )
     239      (fixnum-type-error 'fxmod0 fxn) ) )
     240
     241(define (fx*/carry fx1 fx2 fx3)
     242  (let ([s0 (fx+ (fx* fx1 fx2) fx3)])
     243    (values s0
     244            (arithmetic-shift (+ (* fx1 fx2) (- fx3 s0)) (- fixnum-precision)) ) ) )
     245
     246(define (fx+/carry fx1 fx2 fx3)
     247  (let ([s0 (fx+ (fx+ fx1 fx2) fx3)])
     248    (values s0
     249            (arithmetic-shift (+ (+ fx1 fx2) (- fx3 s0)) (- fixnum-precision)) ) ) )
     250
     251(define (fx-/carry fx1 fx2 fx3)
     252  (let ([s0 (fx- (fx- fx1 fx2) fx3)])
     253    (values s0
     254            (arithmetic-shift (- (- fx1 fx2) (+ s0 fx3)) (- fixnum-precision)) ) ) )
     255
     256(define (fxadd1 fx)
     257  (fx+ fx 1) )
     258
     259(define (fxsub1 fx)
     260  (fx- fx 1) )
     261
     262(define fxquotient fx/)
     263
     264(define (fxremainder fxn fxd)
     265  (fx- fxn (fx* (fx/ fxn fxd) fxd)) )
     266
     267(define fxmodulo fxmod)
    146268
    147269(define (fxarithmetic-shift fx amount)
     
    179301;;;
    180302
     303(define fixnum->string
     304  (let ([digits "0123456789ABCDEF"])
     305    (lambda (fx #!optional (radix 10))
     306      (letrec ([fx-digits
     307                 (lambda (fx from to)
     308                   (if (fx= 0 fx)
     309                       (values (make-string from) to)
     310                       (let* ([quo (fx/ fx radix)]
     311                              [digit (string-ref digits (fx- fx (fx* quo radix)))])
     312                           (let-values ([(str to) (fx-digits quo (fx+ from 1) to)])
     313                             (string-set! str to digit)
     314                             (values str (fx+ to 1)) ) ) ) ) ]
     315               [fx->str
     316                 (lambda (fx)
     317                   (cond [(fx= 0 fx)
     318                           (string #\0)]
     319                         [(fx> fx 0)
     320                           (fx-digits fx 0 0)]
     321                         [(fx= fx most-negative-fixnum)
     322                           (string-append (fx->str (fx/ fx radix))
     323                                          (fx->str (fx- radix (fxmod fx radix))))]
     324                         [else
     325                           (let ([str (fx-digits (fxneg fx) 1 1)])
     326                             (string-set! str 0 #\-)
     327                             str ) ] ) ) ] )
     328        (unless (fixnum? fx)
     329          (fixnum-type-error 'fixnum->string fx) )
     330        (case radix
     331          [(2 8 10 16)
     332            (fx->str fx)]
     333          [else
     334            (##sys#signal-hook #:type-error 'fixnum->string
     335                               "bad argument type - invalid radix" radix) ] ) ) ) ) )
     336
     337;;;
     338
    181339(define (fxif mask true false)
    182         (bitwise-if mask true false) )
     340        (%bitwise-if mask true false) )
    183341
    184342(define (fxbit-count fx)
    185         (bitwise-bit-count fx) )
     343        (%bitwise-bit-count fx) )
    186344
    187345(define (fxlength fx)
    188         (bitwise-length fx) )
     346        (%bitwise-length fx) )
    189347
    190348(define (fxfirst-bit-set fx)
    191         (bitwise-first-bit-set fx) )
     349        (%bitwise-first-bit-set fx) )
    192350
    193351(define (fxlast-bit-set fx)
    194         (bitwise-last-bit-set fx) )
     352        (%bitwise-last-bit-set fx) )
    195353
    196354(define (fxbit-set? fx index)
    197         (bitwise-bit-set? fx index) )
     355        (%bitwise-bit-set? fx index) )
    198356
    199357(define (fxcopy-bit fx index bit)
    200         (bitwise-copy-bit fx index bit) )
     358        (%bitwise-copy-bit fx index bit) )
    201359
    202360(define (fxbit-field fx start end)
    203         (bitwise-bit-field fx start end) )
     361        (%bitwise-bit-field fx start end) )
    204362
    205363(define (fxcopy-bit-field fxto start end fxfrom)
    206         (bitwise-copy-bit-field fxto start end fxfrom) )
     364        (%bitwise-copy-bit-field fxto start end fxfrom) )
    207365
    208366(define (fxrotate-bit-field fx start end count)
    209         (bitwise-rotate-bit-field fx start end count) )
     367        (%bitwise-rotate-bit-field fx start end count) )
    210368
    211369(define (fxreverse-bit-field fx start end)
    212         (bitwise-reverse-bit-field fx start end) )
    213 
     370        (%bitwise-reverse-bit-field fx start end) )
     371
  • release/3/mathh/trunk/flonum-extras.scm

    r8546 r8556  
    1515    fl<=?
    1616    fl>=?
     17    flcompare
    1718    flinteger?
    1819    flzero?
     
    3031    flmax
    3132    flmin
     33    flmax-and-min
    3234    flabs
    3335    flfraction
     
    3941    flmod
    4042    fldiv-and-mod
     43    fldiv0
     44    flmod0
     45    fldiv0-and-mod0
    4146    flexp
    4247    fllog
     
    4954    flsqrt
    5055    flexpt
    51     #;flnumerator
    52     #;fldenominator ) )
     56    flnumerator
     57    fldenominator ) )
    5358
    5459(use mathh)
     
    6267              (loop (func acc (car lyst)) (cdr lyst)) ) ) )
    6368
    64 (define-inline (%fpfraction n)
    65   (##sys#flonum-fraction n) )
    66 
    67 (define-inline (%fptruncate n)
    68   (modf n) )
    69 
    70 (define-inline (%fpfloor n)
    71   (if (fp= 0.0 n)
     69(define-inline (%and-fold1 func init lyst)
     70  (let loop ([prv init] [lyst lyst])
     71          (or (null? lyst)
     72              (and (func prv (car lyst))
     73             (loop (car lyst) (cdr lyst)) ) ) ) )
     74
     75(define %fpfrac ##sys#flonum-fraction)
     76
     77(define %fptrunc modf)
     78
     79(define-inline (%fpfloor fp)
     80  (if (fp= 0.0 fp)
    7281      0.0
    73       (let ([nt (%fptruncate n)])
    74         (if (fp< 0.0 n)
     82      (let ([nt (%fptrunc fp)])
     83        (if (fp< 0.0 fp)
    7584            nt
    7685            (fp- nt 1.0) ) ) ) )
    7786
    78 (define-inline (%fpceiling n)
    79   (if (fp= 0.0 n)
     87(define-inline (%fpceil fp)
     88  (if (fp= 0.0 fp)
    8089      0.0
    81       (let ([nt (%fptruncate n)])
    82         (if (or (fp< 0.0 n) (not (fp= n nt)))
     90      (let ([nt (%fptrunc fp)])
     91        (if (or (fp< 0.0 fp) (not (fp= fp nt)))
    8392            (fp+ nt 1.0)
    8493            nt ) ) ) )
    8594
    86 (define-inline (%fpround x)
    87   (%fptruncate (if (fp< 0.0 x) (fp+ x 0.5) (fp- x 0.5))) )
    88 
    89 (define-inline (%fpremainder x y)
    90   (fp- x (fp* (fldiv x y) y)) )
     95(define-inline (%fprnd fp)
     96  (if (fp= 0.0 fp)
     97      0.0
     98      (%fptrunc (fp+ fp (if (fp< 0.0 fp) 0.5 -0.5))) ) )
     99
     100(define-inline (%fpquo fpn fpd)
     101  (%fptrunc (fp/ fpn fpd)) )
     102
     103(define-inline (%fprem fpn fpd)
     104  (fp- fpn (fp* (%fptrunc (fp/ fpn fpd)) fpd)) )
     105
     106(define-inline (%fpquo-and-rem fpn fpd)
     107  (let ([quo (%fpquo fpn fpd)])
     108    (values quo (fp- fpn (fp* quo fpd))) ) )
    91109
    92110(define-inline (%fp< x y)
    93   (or (and (fp= -0.0 x) (fp= 0.0 y))
     111  (or (and (fp= -0.0 x)
     112           (fp= 0.0 y))
    94113      (fp< x y) ) )
    95114
    96115(define-inline (%fp<= x y)
    97   (or (and (fp= -0.0 x) (fp= 0.0 y))
     116  (or (and (fp= -0.0 x)
     117           (fp= 0.0 y))
    98118      (fp<= x y) ) )
    99119
    100120(define-inline (%fp> x y)
    101   (or (and (fp= -0.0 y) (fp= 0.0 x))
     121  (or (and (fp= 0.0 x)
     122           (fp= -0.0 y))
    102123      (fp> x y) ) )
    103124
    104125(define-inline (%fp>= x y)
    105   (or (and (fp= -0.0 y) (fp= 0.0 x))
     126  (or (and (fp= 0.0 x)
     127           (fp= -0.0 y))
    106128      (fp>= x y) ) )
    107129
    108 (define-inline (%fpinteger? fl)
    109   (fp= 0.0 (%fpfraction fl)) )
    110 
    111 ;;;
    112 
    113 (define (real->flonum value)
    114   (exact->inexact value) )
    115 
    116 (define (fixnum->flonum value)
    117   (exact->inexact value) )
     130(define-inline (%fpinteger? fp)
     131  (fp= 0.0 (%fpfrac fp)) )
     132
     133(define (%fpnan? fp)
     134  (not (fp= fp fp)) )
     135
     136(define-inline (%fpdiv0-and-mod0 fpn fpd)
     137  (let-values ([(quo rem) (%fpquo-and-rem fpn fpd)])
     138    (cond [(fp>= fpd 0.0)
     139            (if (fp< rem (fp/ fpd 2.0))
     140                (if (fp>= rem (fp/ fpd -2.0))
     141                    (values quo rem)
     142                    (values (fp- quo 1.0) (fp+ rem fpd)) )
     143                (values (fp+ quo 1.0) (fp- rem fpd)) ) ]
     144          [(fp< rem (fp/ fpd -2.0))
     145            (if (fp>= rem (fp/ fpd 2.0))
     146                (values quo rem)
     147                (values (fp+ quo 1.0) (fp- rem fpd)) ) ]
     148          [else
     149            (values (fp- quo 1.0) (fp+ rem fpd)) ] ) ) )
     150
     151(define-inline (%fpdiv0 fpn fpd)
     152  (let-values ([(quo rem) (%fpquo-and-rem fpn fpd)])
     153    (cond [(fp>= fpd 0.0)
     154            (if (fp< rem (fp/ fpd 2.0))
     155                (if (fp>= rem (fp/ fpd -2.0))
     156                    quo
     157                    (fp- quo 1.0) )
     158                (fp+ quo 1.0) ) ]
     159          [(fp< rem (fp/ fpd -2.0))
     160            (if (fp>= rem (fp/ fpd 2.0))
     161                quo
     162                (fp+ quo 1.0) ) ]
     163          [else
     164            (fp- quo 1.0) ] ) ) )
     165
     166(define-inline (%fpmod0 fpn fpd)
     167  (let ([rem (%fprem fpn fpd)])
     168    (cond [(fp>= fpd 0.0)
     169            (if (fp< rem (fp/ fpd 2.0))
     170                (if (fp>= rem (fp/ fpd -2.0))
     171                    rem
     172                    (fp+ rem fpd) )
     173                (fp- rem fpd) ) ]
     174          [(fp< rem (fp/ fpd -2.0))
     175            (if (fp>= rem (fp/ fpd 2.0))
     176                rem
     177                (fp- rem fpd) )]
     178          [else
     179            (fp+ rem fpd) ] ) ) )
     180
     181;;;
     182
     183(define real->flonum
     184  (let ([exact->inexact exact->inexact])
     185    (lambda (value)
     186      (if (flonum? value)
     187          value
     188          (exact->inexact value) ) ) ) )
     189
     190(define fixnum->flonum
     191  (let ([exact->inexact exact->inexact])
     192    (lambda (fx)
     193      (unless (fixnum? fx)
     194        (##sys#signal-hook #:type-error 'fixnum->flonum
     195                           "bad argument type - not a fixnum" fx) )
     196      (exact->inexact fx) ) ) )
    118197
    119198;;;
    120199
    121200(define (fl=? fl . rest)
    122         (%fold1 fp= fl rest) )
     201        (%and-fold1 fp= fl rest) )
    123202
    124203(define (fl<? fl . rest)
    125         (let loop ([fl fl] [rest rest])
    126           (or (null? rest)
    127               (let ([fl1 (car rest)])
    128           (and (%fp< fl fl1)
    129                (loop fl1 (cdr rest)) ) ) ) ) )
     204        (%and-fold1 %fp< fl rest) )
    130205
    131206(define (fl>? fl . rest)
    132         (let loop ([fl fl] [rest rest])
    133           (or (null? rest)
    134               (let ([fl1 (car rest)])
    135           (and (%fp> fl fl1)
    136                (loop fl1 (cdr rest)) ) ) ) ) )
     207        (%and-fold1 %fp> fl rest) )
    137208
    138209(define (fl<=? fl . rest)
    139         (let loop ([fl fl] [rest rest])
    140           (or (null? rest)
    141               (let ([fl1 (car rest)])
    142           (and (%fp<= fl fl1)
    143                (loop fl1 (cdr rest)) ) ) ) ) )
     210        (%and-fold1 %fp<= fl rest) )
    144211
    145212(define (fl>=? fl . rest)
    146         (let loop ([fl fl] [rest rest])
    147           (or (null? rest)
    148               (let ([fl1 (car rest)])
    149           (and (%fp>= fl fl1)
    150                (loop fl1 (cdr rest)) ) ) ) ) )
     213        (%and-fold1 %fp>= fl rest) )
     214
     215(define (flcompare fl1 fl2)
     216        (cond [(fp= fl1 fl2)
     217                (cond [(fp= -0.0 fl1)
     218                  (if (fp= -0.0 fl1) 0 1) ]
     219                      [(fp= -0.0 fl2)
     220                        (if (fp= 0.0 fl1) -1 0) ]
     221                      [else
     222                        0 ] ) ]
     223              [(fp< fl1 fl2)
     224                -1 ]
     225              [else
     226                1 ] ) )
     227
     228(define (flmax fl . rest)
     229        (%fold1 fpmax fl rest) )
     230
     231(define (flmin fl . rest)
     232        (%fold1 fpmin fl rest) )
     233
     234(define (flmax-and-min fl . rest)
     235        (let loop ([mx fl] [mn fl] [lyst rest])
     236          (if (null? lyst)
     237              (values mx mn)
     238              (let ([cur (car lyst)])
     239          (loop (fpmax mx cur) (fpmin mn cur) (cdr lyst)) ) ) ) )
    151240
    152241;;;
     
    162251
    163252(define (flnegative? fl)
    164         (and (not (fp= -0.0 fl))
    165        (fp< fl 0.0) ) )
     253        (or (fp= -0.0 fl)
     254      (fp< fl 0.0) ) )
    166255
    167256(define (flodd? fl)
    168   (and (%fpinteger? fl)
    169        (not (fp= 0.0 (%fpfraction (fp/ fl 2.0)))) ) )
     257  (fx= 1 (bitwise-and (%fptrunc fl) #b1)) )
    170258
    171259(define (fleven? fl)
    172   (and (%fpinteger? fl)
    173        (fp= 0.0 (%fpfraction (fp/ fl 2.0))) ) )
     260  (fx= 0 (bitwise-and (%fptrunc fl) #b1)) )
    174261
    175262(define (flfinite? fl)
     
    180267
    181268(define (flnan? fl)
    182   (not (fp= fl fl)) )
     269  (%fpnan? fl) )
    183270
    184271;;;
     
    198285  (or (and (null? rest)
    199286           (fp/ 1.0 fl) )
    200         (%fold1 fp+ fl rest) ) )
    201 
    202 (define (flmax fl . rest)
    203         (%fold1 fpmax fl rest) )
    204 
    205 (define (flmin fl . rest)
    206         (%fold1 fpmin fl rest) )
     287        (%fold1 fp/ fl rest) ) )
    207288
    208289(define (flabs fl)
    209   (if (fp< fl 0.0)
    210       (fpneg fl)
    211       fl ) )
     290  (cond [(fp= -0.0 fl)  0.0]
     291        [(fp< fl 0.0)   (fpneg fl)]
     292        [else           fl] ) )
    212293
    213294(define (flfraction fl)
    214   (%fpfraction fl) )
     295  (%fpfrac fl) )
    215296
    216297(define (fltruncate fl)
    217   (%fptruncate fl) )
     298  (%fptrunc fl) )
    218299
    219300(define (flfloor fl)
     
    221302
    222303(define (flceiling fl)
    223   (%fpceiling fl) )
     304  (%fpceil fl) )
    224305
    225306(define (flround fl)
    226   (%fpround fl) )
     307  (%fprnd fl) )
    227308
    228309(define (fldiv fln fld)
    229   (%fptruncate (fp/ fln fld)) )
     310  (%fpquo fln fld) )
    230311
    231312(define (flmod fln fld)
    232   (fpmod fln fld) )
     313  (%fprem fln fld) )
    233314
    234315(define (fldiv-and-mod fln fld)
    235         (values (fp/ fln fld) (flmod fln fld)) )
    236 
    237 #|
     316  (%fpquo-and-rem fln fld) )
     317
     318(define (fldiv0 fln fld)
     319  (%fpdiv0 fln fld) )
     320
    238321(define (flmod0 fln fld)
    239   (mod0 fln fld) )
    240 
    241 (define (fldiv0 fln fld)
    242   (div0 fln fld) )
     322  (%fpmod0 fln fld) )
    243323
    244324(define (fldiv0-and-mod0 fln fld)
    245   (values (fldiv0 fln fld) (flmod0 fln fld)) )
    246 |#
    247 
    248 (define (flexp fl)
    249         (exp fl) )
    250 
    251 (define (fllog fl #!optional base)
    252   (or (and base
    253            ((make-log/base base) fl) )
    254       #;
    255       (and (VERY-SMALL fl)
    256            (log1p (fp- fl 1.0)) )
    257       (log fl) ) )
    258 
    259 (define (flsin fl)
    260         (sin fl) )
    261 
    262 (define (flcos fl)
    263         (cos fl) )
    264 
    265 (define (fltan fl)
    266         (tan fl) )
    267 
    268 (define (flasin fl)
    269         (asin fl) )
    270 
    271 (define (flacos fl)
    272         (acos fl) )
    273 
    274 (define (flatan fl #!optional fld)
    275   (or (and fld
    276            (atan (fp/ fl fld)) )
    277             (atan fl) ) )
    278 
    279 (define (flsqrt fl)
    280   (sqrt fl) )
    281 
    282 (define (flexpt fl exp)
    283         (or (and (= 2.0 fl)
    284            (ldexp 1.0 exp) )
    285       (expt fl exp) ) )
    286 
    287 #;
     325  (%fpdiv0-and-mod0 fln fld) )
     326
     327(define flexp
     328  (let ([exp exp])
     329    (lambda (fl)
     330      (exp fl) ) ) )
     331
     332(define fllog
     333  (let ([log log])
     334    (lambda (fl #!optional base)
     335      (or (and base
     336               ((make-log/base base) fl) )
     337          #;
     338          (and (VERY-SMALL-FLONUM? fl)
     339               (log1p (fp- fl 1.0)) )
     340          (log fl) ) ) ) )
     341
     342(define flsin
     343        (let ([sin sin])
     344                (lambda (fl)
     345                        (sin fl) ) ) )
     346
     347(define flcos
     348        (let ([cos cos])
     349                (lambda (fl)
     350                        (cos fl) ) ) )
     351
     352(define fltan
     353        (let ([tan tan])
     354                (lambda (fl)
     355                        (tan fl) ) ) )
     356
     357(define flasin
     358        (let ([asin asin])
     359                (lambda (fl)
     360                        (asin fl) ) ) )
     361
     362(define flacos
     363        (let ([acos acos])
     364                (lambda (fl)
     365                        (acos fl) ) ) )
     366
     367(define flatan
     368  (let ([atan atan])
     369    (lambda (fl #!optional fld)
     370      (or (and fld
     371               (atan (fp/ fl fld)) )
     372          (atan fl) ) ) ) )
     373
     374(define flsqrt
     375  (let ([sqrt sqrt])
     376    (lambda (fl)
     377      (sqrt fl) ) ) )
     378
     379(define flexpt
     380  (let ([expt expt])
     381    (lambda (fl exp)
     382      (or (and (= 2.0 fl)
     383               (ldexp 1.0 exp) )
     384          (expt fl exp) ) ) ) )
     385
    288386(define (flnumerator fl)
    289   (or (and (fx= -0.0 fl)
    290            -0.0 )
    291       XXX ) )
    292 
    293 #;
     387  fl )
     388
    294389(define (fldenominator fl)
    295   (or (and (fx= 0.0 fl)
    296            1.0 )
    297       XXX ) )
    298 
     390  (if (%fpnan? fl)
     391      fl
     392      1.0 ) )
  • release/3/mathh/trunk/mathh.html

    r8544 r8556  
    579579<div class="section">
    580580<h3>Usage</h3>(require-extension fixnum-extras)</div>
     581<dt class="definition"><strong>procedure:</strong> (fixnum-&gt;string FX [RADIX])</dt>
     582<dd>
     583<p></p></dd>
    581584<dt class="definition"><strong>procedure:</strong> (fixnum-width)</dt>
    582585<dd>
     
    603606<dd>
    604607<p></p></dd>
     608<dt class="definition"><strong>procedure:</strong> (fxcompare FX1 FX2)</dt>
     609<dd>
     610<p></p></dd>
    605611<dt class="definition"><strong>procedure:</strong> (fxzero? FX)</dt>
    606612<dd>
     
    624630<dd>
    625631<p></p></dd>
     632<dt class="definition"><strong>procedure:</strong> (fxmax-and-minFX ...)</dt>
     633<dd>
     634<p></p></dd>
     635<dt class="definition"><strong>procedure:</strong> (fxmodulo FX-N FX-D)</dt>
     636<dd>
     637<p></p></dd>
     638<dt class="definition"><strong>procedure:</strong> (fxdiv FX-N FX-D)</dt>
     639<dd>
     640<p></p></dd>
    626641<dt class="definition"><strong>procedure:</strong> (fxdiv-and-mod FX-N FX-D)</dt>
     642<dd>
     643<p></p></dd>
     644<dt class="definition"><strong>procedure:</strong> (fxdiv0 FX-N FX-D)</dt>
     645<dd>
     646<p></p></dd>
     647<dt class="definition"><strong>procedure:</strong> (fxmod0 FX-N FX-D)</dt>
     648<dd>
     649<p></p></dd>
     650<dt class="definition"><strong>procedure:</strong> (fxdiv0-and-mod0 FX-N FX-D)</dt>
     651<dd>
     652<p></p></dd>
     653<dt class="definition"><strong>procedure:</strong> (fx*/carry FX1 FX2 FX3)</dt>
     654<dd>
     655<p></p></dd>
     656<dt class="definition"><strong>procedure:</strong> (fx+/carry FX1 FX2 FX3)</dt>
     657<dd>
     658<p></p></dd>
     659<dt class="definition"><strong>procedure:</strong> (fx-/carry FX1 FX2 FX3)</dt>
     660<dd>
     661<p></p></dd>
     662<dt class="definition"><strong>procedure:</strong> (fxadd1 FX)</dt>
     663<dd>
     664<p></p></dd>
     665<dt class="definition"><strong>procedure:</strong> (fxsub1 FX)</dt>
     666<dd>
     667<p></p></dd>
     668<dt class="definition"><strong>procedure:</strong> (fxquotient FX-N FX-D)</dt>
     669<dd>
     670<p></p></dd>
     671<dt class="definition"><strong>procedure:</strong> (fxremainder FX-N FX-D)</dt>
    627672<dd>
    628673<p></p></dd>
     
    706751<dd>
    707752<p></p></dd>
     753<dt class="definition"><strong>procedure:</strong> (flcompare FL1 FL2)</dt>
     754<dd>
     755<p></p></dd>
    708756<dt class="definition"><strong>procedure:</strong> (flinteger? FL)</dt>
    709757<dd>
     
    751799<dd>
    752800<p></p></dd>
     801<dt class="definition"><strong>procedure:</strong> (flmax-and-min FL ...)</dt>
     802<dd>
     803<p></p></dd>
    753804<dt class="definition"><strong>procedure:</strong> (flabs FL)</dt>
    754805<dd>
     
    778829<dd>
    779830<p></p></dd>
     831<dt class="definition"><strong>procedure:</strong> (fldiv0 FL-N FL-D)</dt>
     832<dd>
     833<p></p></dd>
     834<dt class="definition"><strong>procedure:</strong> (flmod0 FL-N FL-D)</dt>
     835<dd>
     836<p></p></dd>
     837<dt class="definition"><strong>procedure:</strong> (fldiv0-and-mod0 FL-N FL-D)</dt>
     838<dd>
     839<p></p></dd>
    780840<dt class="definition"><strong>procedure:</strong> (flexp FL)</dt>
    781841<dd>
     
    806866<p></p></dd>
    807867<dt class="definition"><strong>procedure:</strong> (flexpt FL EXP)</dt>
     868<dd>
     869<p></p></dd>
     870<dt class="definition"><strong>procedure:</strong> (flnumerator FL)</dt>
     871<dd>
     872<p></p></dd>
     873<dt class="definition"><strong>procedure:</strong> (fldenominator FL)</dt>
    808874<dd>
    809875<p></p></dd></div>
  • release/3/mathh/trunk/tests/mathh-test.scm

    r8511 r8556  
    44(use testbase testbase-output-human)
    55(use mathh mathh-int mathh-float mathh-fpclass)
    6 #;
    76(use fixnum-extras)
     7(use flonum-extras)
    88(use bitwise-extras)
    99
     
    7171#;
    7272(define-test mathh-fixnum-test "Fixnum Functions"
     73)
     74
     75#;
     76(define-test mathh-flonum-test "Flonum Functions"
    7377)
    7478
Note: See TracChangeset for help on using the changeset viewer.