Changeset 14004 in project


Ignore:
Timestamp:
03/31/09 04:01:40 (11 years ago)
Author:
Kon Lovett
Message:

Added routines

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

Legend:

Unmodified
Added
Removed
  • release/4/mathh/trunk/mathh.scm

    r13652 r14004  
    5252  log10 log2 make-log/base log1p
    5353  fpmod modf ldexp scalbn frexp
     54  signbit copysign nextafter
     55  cbrt
    5456  fpclassify
    5557  fpclass)
     
    127129        #define #define M_LN2 0.693147180559945309417232121458176568
    128130        #endif
    129         C_return( log( x ) / M_LN2 );
    130        ")
     131        return( log( x ) / M_LN2 );")
    131132      #;
    132133      (foreign-lambda* double ((double x)) "
     
    137138        # define M_E 2.71828182845904523536028747135266250
    138139        #endif
    139         C_return( (log( 2.0 * M_PI * x) / 2.0) + (x * log( x / M_E )) );
    140         ") ) ) )
     140        return( (log( 2.0 * M_PI * x) / 2.0) + (x * log( x / M_E )) );") ) ) )
    141141
    142142;; Natural logarithm of 1+x accurate for very small x
     
    145145  (cond-expand
    146146    (windows ; potentially inaccurate but ...
    147       (foreign-lambda* double ((double x)) "C_return( log( 1.0 + x ) );") )
     147      (foreign-lambda* double ((double x)) "return( log( 1.0 + x ) );") )
    148148    (else
    149149                  (foreign-lambda double "log1p" double) ) ) )
     
    158158  (cond-expand
    159159    (windows ; not efficient but ...
    160       (foreign-lambda* double ((double x) (integer n)) "C_return( ldexp( x, n ) );"))
     160      (foreign-lambda* double ((double x) (integer n)) "return( ldexp( x, n ) );"))
    161161    (else
    162162      (foreign-lambda double "scalbn" double integer))) )
     
    172172         (let ((lnb (log b)))
    173173           (lambda (n)
    174              ((foreign-lambda* double ((double x) (double lnb)) "C_return( log( x ) / lnb );") n lnb)) ) ) ) )
     174             ((foreign-lambda* double ((double x) (double lnb)) "return( log( x ) / lnb );") n lnb)) ) ) ) )
    175175
    176176;; Flonum remainder
     
    200200  ") )
    201201
     202;; Returns arg1 with same sign as arg2
     203
     204(define copysign
     205  (cond-expand
     206    (windows (foreign-lambda double "_copysign" double double))
     207    (else (foreign-lambda double "copysign" double double)) ) )
     208
     209;; Increments/decrements arg1 in the direction of arg2
     210
     211(define nextafter
     212  (cond-expand
     213    (windows (foreign-lambda double "_nextafter" double double))
     214    (else (foreign-lambda double "nextafter" double double)) ) )
     215
     216;; #t when negative, #f otherwise
     217
     218(define signbit
     219  (cond-expand
     220    (windows (foreign-lambda* bool ((double n)) "return( _copysign( 1.0, n ) < 0 );"))
     221    (else (foreign-lambda bool "signbit" double)) ) )
     222
     223;; Cube Root
     224
     225(define cbrt
     226  (cond-expand
     227    (windows (lambda-unimplemented 'cbrt))
     228    (else (foreign-lambda double "cbrt" double)) ) )
     229
    202230;; Returns a symbol denoting the kind of floating-point number.
    203231
     
    242270          break;
    243271        }
    244         C_return( name );
    245                           ") )
     272        return( name );") )
    246273    (else
    247274      (foreign-lambda* symbol ((double x)) "
     
    262289          break;
    263290        case FP_ZERO:
    264           name = x == -0.0 ? \"negative-zero\" : \"positive-zero\";
     291          name = signbit( x ) ? \"negative-zero\" : \"positive-zero\";
    265292          break;
    266293        default:
     
    268295          break;
    269296        }
    270         C_return( name );
    271                           ") ) ) )
     297        return( name );") ) ) )
    272298
    273299;; Returns a symbol denoting the kind of floating-point number.
     
    303329          break;
    304330        }
    305         C_return( name );
    306                           ") )
     331        return( name );") )
    307332    (else
    308333      (foreign-lambda* symbol ((double x)) "
     
    328353          break;
    329354        }
    330         C_return( name );
    331                           ") ) ) )
     355        return( name );") ) ) )
    332356
    333357) ;module mathh
  • release/4/mathh/trunk/tests/run.scm

    r13570 r14004  
    6868        (test 'normal (fpclassify (fp/ 33.0 44.5)))
    6969)
     70
     71(test-group "BSD Functions"
     72
     73        (test-assert (signbit -1.0))
     74        (test-assert (not (signbit 1.0)))
     75        (test-assert (signbit -0.0))
     76
     77        (test -1.0 (copysign 1.0 -1.0))
     78        (test 1.0 (copysign -1.0 1.0))
     79
     80        (test 1.0 (nextafter 1.0 -1.0))
     81        (test -1.0 (nextafter -1.0 1.0))
     82
     83        (test 2.4662 (cbrt 15.0))
     84)
Note: See TracChangeset for help on using the changeset viewer.