Changeset 35264 in project


Ignore:
Timestamp:
03/08/18 18:48:23 (3 months ago)
Author:
kon
Message:

d'oh

Location:
release/4/mathh/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/mathh/trunk/fp-utils.scm

    r35160 r35264  
    11;;;; fp-utils.scm
    22;;;; Kon Lovett, May '17
     3;;;; Kon Lovett, Mar '18
    34
    45;;;; Issues
    5 ;;;;
     6;;
     7;; - all instances of (fl<? -0.0 0.0) found ?
    68
    79(module fp-utils
     
    4648
    4749(import scheme chicken foreign)
    48 
    4950(use
    50   extras
     51  (only extras random)
    5152  (only mathh log10))
    5253
     
    6566
    6667(: *fpeven? (float --> boolean))
     68;
    6769(define (*fpeven? n)
    68   (fp= 0.0 (##sys#flonum-fraction (fp/ n 2.0))) )
     70  (let ((r (##sys#flonum-fraction (fp/ n 2.0))))
     71    (or (fp= 0.0 r) (fp= -0.0 r)) ) )
    6972
    7073(define (check-inexact loc obj)
     
    7780
    7881(: fprandom (#!optional (or float fixnum) -> float))
     82;
    7983(define (fprandom #!optional lim (low 0))
    8084  (let* (
     
    8690        ((flonum? lim)
    8791          (let (
    88             (sign? (fpnegative? lim) )
    89             (lim (inexact->exact (expt 10 (abs (round (log10 lim))))) ) )
     92            (sign? (fpnegative? lim))
     93            (lim (inexact->exact (expt 10 (round (log10 (abs lim)))))) )
    9094            (if sign? (fxneg lim) lim) ) )
    9195        (else
     
    102106
    103107(: fpzero? (float --> boolean))
     108;
    104109(define (fpzero? n)
    105110  (fp= 0.0 n) )
    106111
    107112(: fppositive? (float --> boolean))
     113;
    108114(define (fppositive? n)
    109   (fp< 0.0 n) )
     115  (or
     116    (fp= -0.0 n)
     117    (fp< 0.0 n)) )
    110118
    111119(: fpcardinal? (float --> boolean))
     120;
    112121(define (fpcardinal? n)
    113   (fp<= 0.0 n) )
     122  (and
     123    (not (fp= -0.0 n))
     124    (fp<= 0.0 n)) )
    114125
    115126(: fpnegative? (float --> boolean))
     127;
    116128(define (fpnegative? n)
    117   (fp> 0.0 n) )
     129  (and
     130    (not (fp= -0.0 n))
     131    (fp> 0.0 n)) )
    118132
    119133(: fpnon-positive? (float --> boolean))
     134;
    120135(define (fpnon-positive? n)
    121136  (fp>= 0.0 n) )
     
    124139
    125140(: fpeven? (float --> boolean))
     141;
    126142(define (fpeven? n)
    127143  (and
     
    130146
    131147(: fpodd? (float --> boolean))
     148;
    132149(define (fpodd? n)
    133150  (and
     
    138155
    139156(: fpclosed-right? (float float float --> boolean))
     157;
    140158(define (fpclosed-right? l x h)
    141159  (and (fp< l x) (fp<= x h)) )
    142160
    143161(: fpclosed? (float float float --> boolean))
     162;
    144163(define (fpclosed? l x h)
    145164  (and (fp<= l x) (fp<= x h)) )
    146165
    147166(: fpclosed-left? (float float float --> boolean))
     167;
    148168(define (fpclosed-left? l x h)
    149169  (and (fp<= l x) (fp< x h)) )
     
    155175
    156176(: fpadd1 (float --> float))
     177;
    157178(define (fpadd1 n)
    158179  (fp+ n 1.0) )
    159180
    160181(: fpsub1 (float --> float))
     182;
    161183(define (fpsub1 n)
    162184  (fp- n 1.0) )
     
    165187
    166188(: fpmodulo (float float --> float))
     189;
    167190(define (fpmodulo x y)
    168191  (fptruncate
     
    172195
    173196(: fpquotient (float float --> float))
     197;
    174198(define (fpquotient x y)
    175199  (fptruncate (fp/ x y)) )
    176200
    177201(: fpremainder (float float --> float))
     202;
    178203(define (fpremainder x y)
    179204  (fptruncate
     
    185210
    186211(: fpfraction (float --> float))
     212;
    187213(define (fpfraction n)
    188214        (##sys#flonum-fraction n) )
     
    193219
    194220(: fp~= (float float #!optional float --> boolean))
     221;
    195222(define (fp~= x y #!optional (eps flonum-epsilon))
    196223  (let ((diff (fp- x y)))
     
    200227
    201228(: fp~<= (float float #!optional float --> boolean))
     229;
    202230(define (fp~<= x y #!optional (eps flonum-epsilon))
    203231  (or
     
    206234
    207235(: fp~>= (float float #!optional float --> boolean))
     236;
    208237(define (fp~>= x y #!optional (eps flonum-epsilon))
    209238  (or
     
    216245
    217246(: fpsqr (float --> float))
     247;
    218248(define (fpsqr n)
    219249  (fp* n n) )
    220250
    221251(: fpcub (float --> float))
     252;
    222253(define (fpcub n)
    223254  (fp* n (fp* n n)) )
     
    239270
    240271(: fptruncate-with-precision (float #!optional float --> float))
     272;
    241273(define fptruncate-with-precision (make-unary-with-precision fptruncate))
    242274
    243275(: fpround-with-precision (float #!optional float --> float))
     276;
    244277(define fpround-with-precision (make-unary-with-precision fpround))
    245278
    246279(: fpceiling-with-precision (float #!optional float --> float))
     280;
    247281(define fpceiling-with-precision (make-unary-with-precision fpceiling))
    248282
    249283(: fpfloor-with-precision (float #!optional float --> float))
     284;
    250285(define fpfloor-with-precision (make-unary-with-precision fpfloor))
    251286
     
    255290
    256291(: fpdegree->radian (float --> float))
     292;
    257293(define (fpdegree->radian deg)
    258294  (fp* deg DEGREE) )
    259295
    260296(: fpradian->degree (float --> float))
     297;
    261298(define (fpradian->degree rad)
    262299  (fp/ rad DEGREE) )
     
    265302
    266303(: fpdistance (float float float float --> float))
     304;
    267305(define (fpdistance x1 y1 x2 y2)
    268306  (fpsqrt (fpdistance* x1 y1 x2 y2)) )
    269307
    270308(: fpdistance* (float float float float --> float))
     309;
    271310(define (fpdistance* x1 y1 x2 y2)
    272311  (fp+ (fpsqr (fp- x1 x2)) (fpsqr (fp- y1 y2))) )
     
    275314
    276315(: fpmax-and-min (float #!rest float --> float float))
     316;
    277317(define (fpmax-and-min fp . fps)
    278318  (let loop ((fps fps) (mx fp) (mn fp))
     
    285325
    286326(: fpprecision-factor ((or float fixnum) #!optional float --> float))
     327;
    287328(define (fpprecision-factor p #!optional (base 10.0))
    288329  (fpexpt base (exact->inexact p)) )
  • release/4/mathh/trunk/fx-utils.scm

    r35160 r35264  
    33
    44;;;; Issues
    5 ;;;;
     5;;
    66
    77(module fx-utils
     
    8686
    8787(: *fxrandom (fixnum --> fixnum))
     88;
    8889(define (*fxrandom x)
    8990  (##core#inline "C_random_fixnum" x) )
    9091
    9192(: *fxadd1 (fixnum --> fixnum))
     93;
    9294(define (*fxadd1 fx)
    9395  (##core#inline "C_fixnum_increase" fx) )
    9496
    9597(: *fxsub1 (fixnum --> fixnum))
     98;
    9699(define (*fxsub1 fx)
    97100  (##core#inline "C_fixnum_decrease" fx) )
     
    99102#|
    100103(: *pow2log2 (fixnum --> fixnum))
     104;
    101105(define *pow2log2
    102106  (foreign-lambda* unsigned-long ((long n))
     
    109113
    110114(: fxrandom (#!optional fixnum -> fixnum))
     115;
    111116(define (fxrandom #!optional lim (low 0))
    112117  (let* (
     
    120125
    121126(: fxzero? (fixnum --> boolean))
     127;
    122128(define (fxzero? n)
    123129  (fx= 0 n) )
    124130
    125131(: fxpositive? (fixnum --> boolean))
     132;
    126133(define (fxpositive? n)
    127134  (fx< 0 n) )
    128135
    129136(: fxcardinal? (fixnum --> boolean))
     137;
    130138(define (fxcardinal? n)
    131139  (fx<= 0 n) )
    132140
    133141(: fxnegative? (fixnum --> boolean))
     142;
    134143(define (fxnegative? n)
    135144  (fx> 0 n) )
    136145
    137146(: fxnon-positive? (fixnum --> boolean))
     147;
    138148(define (fxnon-positive? n)
    139149  (fx>= 0 n) )
     
    142152
    143153(: fxclosed-right? (fixnum fixnum fixnum --> boolean))
     154;
    144155(define (fxclosed-right? l x h)
    145156  (and (fx< l x) (fx<= x h)) )
    146157
    147158(: fxclosed? (fixnum fixnum fixnum --> boolean))
     159;
    148160(define (fxclosed? l x h)
    149161  (and (fx<= l x) (fx<= x h)) )
    150162
    151163(: fxclosed-left? (fixnum fixnum fixnum --> boolean))
     164;
    152165(define (fxclosed-left? l x h)
    153166  (and (fx<= l x) (fx< x h)) )
     
    161174
    162175(: fxabs (fixnum --> fixnum))
     176;
    163177(define (fxabs n)
    164178  (if (fxnegative? n) (fxneg n) n) )
     
    167181
    168182(: fxadd1 (fixnum --> fixnum))
     183;
    169184(define (fxadd1 n)
    170185  (*fxadd1 n) )
    171186
    172187(: fxsub1 (fixnum --> fixnum))
     188;
    173189(define (fxsub1 n)
    174190  (*fxsub1 n) )
     
    177193
    178194(: fxlog2 (fixnum --> fixnum))
     195;
    179196(define (fxlog2 n)
    180197  (C_uword_log2 n) )
    181198
    182199(: fxpow2log2 (fixnum --> fixnum))
     200;
    183201(define (fxpow2log2 n)
    184202  (cond
     
    191209
    192210(: fxsqr (fixnum --> fixnum))
     211;
    193212(define (fxsqr n)
    194213  (fx* n n) )
    195214
    196215(: fxcub (fixnum --> fixnum))
     216;
    197217(define (fxcub n)
    198218  (fx* n (fx* n n)) )
     
    201221
    202222(: fxdistance (fixnum fixnum fixnum fixnum --> fixnum))
     223;
    203224(define (fxdistance x1 y1 x2 y2)
    204225  (fx/ (fxdistance* x1 y1 x2 y2) 2) )
    205226
    206227(: fxdistance* (fixnum fixnum fixnum fixnum --> fixnum))
     228;
    207229(define (fxdistance* x1 y1 x2 y2)
    208230  (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2))) )
     
    211233
    212234(: fxmax-and-min (fixnum #!rest fixnum --> fixnum fixnum))
     235;
    213236(define (fxmax-and-min fx . fxs)
    214237  (let loop ((fxs fxs) (mx fx) (mn fx))
  • release/4/mathh/trunk/mathh.scm

    r35160 r35264  
    6262#endif
    6363
     64#if 0 /*defined(_WIN32)*/
    6465/* log2, log1p, erf, erfc, scalbn were not originally provided */
    65 #if 0
    66 /* defined(__CYGWIN__) || defined(__MINGW32__) || defined(_WIN32) || defined(WIN32) || defined(__WIN32__) || defined(__MINGW64__) || defined(_WIN64) || defined(WIN64) || defined(__WIN64__)*/
    6766static double log2( double x )
    6867{
  • release/4/mathh/trunk/mathh.setup

    r35160 r35264  
    1212
    1313;* (The compiler option '-inline-global' causes problems; so no -O3+.)
    14 (setup-shared+static-extension-module (extension-name) (extension-version "3.3.3")
     14(setup-shared+static-extension-module (extension-name) (extension-version "3.4.0")
    1515  ;cannot be inline #1340
    1616  ;#:inline? #t
     
    1919  #:files '("mathh-constants.scm"))
    2020
    21 (setup-shared+static-extension-module 'mathh-consts (extension-version "3.3.3")
     21(setup-shared+static-extension-module 'mathh-consts (extension-version "3.4.0")
    2222  #:inline? #t
    2323  #:types? #t
     
    2727    -no-bound-checks -no-argc-checks -no-procedure-checks))
    2828
    29 (setup-shared+static-extension-module 'fp-utils (extension-version "3.3.3")
     29(setup-shared+static-extension-module 'fp-utils (extension-version "3.4.0")
    3030  #:inline? #t
    3131  #:types? #t
     
    3535    -no-procedure-checks))
    3636
    37 (setup-shared+static-extension-module 'fx-utils (extension-version "3.3.3")
     37(setup-shared+static-extension-module 'fx-utils (extension-version "3.4.0")
    3838  #:inline? #t
    3939  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.