Changeset 13706 in project


Ignore:
Timestamp:
03/12/09 11:22:57 (11 years ago)
Author:
Kon Lovett
Message:

Fixed many invalid ids & parens.

Location:
release/4/err5rs-arithmetic/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/err5rs-arithmetic/trunk/chicken-primitive-object-inlines.scm

    r13697 r13706  
    284284(define-inline (%fx<= x y) (##core#inline "C_fixnum_less_or_equal_p" x y))
    285285
    286 (define-inline (%fxclosed-right? l x h) (and (%< l obj) (%fx<= obj h)))
    287 (define-inline (%fxclosed? l x h) (and (%<= l obj) (%fx<= obj h)))
    288 (define-inline (%fxclosed-left? l x h) (and (%<= l obj) (%fx< obj h)))
     286(define-inline (%fxclosed-right? l x h) (and (%< l x) (%fx<= x h)))
     287(define-inline (%fxclosed? l x h) (and (%<= l x) (%fx<= x h)))
     288(define-inline (%fxclosed-left? l x h) (and (%<= l x) (%fx< x h)))
    289289
    290290(define-inline (%fxzero? fx) (%fx= 0 fx))
     
    456456(define-inline (%fpfraction x) ((##core#primitive "C_flonum_fraction") x))
    457457
    458 (define-inline (%fpnegate x y) (##core#inline_allocate ("C_a_i_flonum_negate" 4) x y))
     458(define-inline (%fpnegate x) (##core#inline_allocate ("C_a_i_flonum_negate" 4) x))
    459459
    460460(define-inline (%fpfloor x) ((##core#primitive "C_flonum_floor") x))
     
    472472(define-inline (%fpasin x) (##core#inline_allocate ("C_a_i_asin" 4) x))
    473473(define-inline (%fpatan x) (##core#inline_allocate ("C_a_i_atan" 4) x))
    474 (define-inline (%fpatan2 x) (##core#inline_allocate ("C_a_i_atan2" 4) x))
     474(define-inline (%fpatan2 x y) (##core#inline_allocate ("C_a_i_atan2" 4) x y))
    475475(define-inline (%fpcos x) (##core#inline_allocate ("C_a_i_cos" 4) x))
    476476(define-inline (%fpexp x) (##core#inline_allocate ("C_a_i_exp" 4) x))
     
    953953(define-inline (%asin x) (##core#inline_allocate ("C_a_i_asin" 4) x))
    954954(define-inline (%atan x) (##core#inline_allocate ("C_a_i_atan" 4) x))
    955 (define-inline (%atan2 x) (##core#inline_allocate ("C_a_i_atan2" 4) x))
     955(define-inline (%atan2 x y) (##core#inline_allocate ("C_a_i_atan2" 4) x y))
    956956(define-inline (%cos x) (##core#inline_allocate ("C_a_i_cos" 4) x))
    957957(define-inline (%exp x) (##core#inline_allocate ("C_a_i_exp" 4) x))
  • release/4/err5rs-arithmetic/trunk/err5rs-arithmetic-bitwise.scm

    r13690 r13706  
    88        (usual-integrations)
    99  (disable-interrupts)
    10         (arithmetic-type generic)
     10        (generic)
    1111        (inline)
    1212        (local)
     
    304304
    305305(define-inline (%boolean->bit* obj)
    306   (if (and (%number obj) (%zero? obj)) #b0
     306  (if (and (%number? obj) (%zero? obj)) #b0
    307307      (%boolean->bit obj) ) )
    308308
     
    412412  (let* ((width (%fx- e s))
    413413         (mask (%bitwise-not (%arithmetic-shift -1 width)))
    414          (field (%bitwise-and mask (%arithmetic-shift n %fxneg s)))) )
     414         (field (%bitwise-and mask (%arithmetic-shift n %fxneg s))) )
    415415    (%bitwise-ior
    416416     (%arithmetic-shift (*bitwise-reverse field width) s)
     
    507507  (%check-integer 'bitwise-copy-bit to)
    508508  (%check-word-bits-range 'bitwise-copy-bit index)
    509   (*bitwise-copy-bit to index (%boolean->bit* bit) bit)) )
     509  (*bitwise-copy-bit to index (%boolean->bit* bit) bit) )
    510510
    511511(define (bitwise-bit-field value start end)
     
    550550(define (bitwise-arithmetic-shift value signed-count)
    551551  (%check-integer 'bitwise-arithmetic-shift value)
    552   (%check-word-bits-range 'bitwise-arithmetic-shift (fxabs signed-count))
     552  (%check-word-bits-range 'bitwise-arithmetic-shift (%fxabs signed-count))
    553553  (%arithmetic-shift value signed-count) )
    554554
  • release/4/err5rs-arithmetic/trunk/err5rs-arithmetic-fixnums.scm

    r13690 r13706  
    88  (usual-integrations)
    99  (disable-interrupts)
    10   (arithmetic-type fixnum)
     10  (fixnum)
    1111  (inline)
    1212  (local)
     
    1818;;
    1919
    20 (require-library err5rs-arithmetic-bitwise)
     20(require-library data-structures err5rs-arithmetic-bitwise)
    2121
    2222(include "chicken-primitive-object-inlines")
    2323
    2424;;
     25
     26(define-inline (%error-outside-range loc obj low high)
     27  (##sys#signal-hook #:bounds-error loc (##core#immutable '"out of range") obj low high) )
    2528
    2629(define-inline (%error-invalid-radix loc radix)
     
    3740(define-inline (%check-fixnum loc obj)
    3841  (unless (%fixnum? obj)
    39     (%error-invalid-fixnum-argument loc obj) ) )
     42    (##sys#signal-hook #:type-error loc (##core#immutable '"bad argument type - not a fixnum") obj) ) )
    4043
    4144(define-inline (%check-cardinal-fixnum loc obj)
     
    193196         (fxior chicken:fxior)
    194197         (fxxor chicken:fxxor))
    195         foreign)
     198        data-structures
     199        foreign
     200        err5rs-arithmetic-bitwise)
    196201
    197202
     
    206211(define (*fxmin x y) (%fxmin x y))
    207212(define (*fxand x y) (%fxand x y))
    208 (define (*fxior x y) (%fxor x y))
     213(define (*fxior x y) (%fxior x y))
    209214(define (*fxxor x y) (%fxxor x y))
    210215(define (*fx+ x y) (%fx+ x y))
     
    368373  (%check-fixnum 'fxarithmetic-shift fx)
    369374  (%check-fixnum 'fxarithmetic-shift amount)
    370   (if (%fxpositive amount) (%fxshr fx (%fxneg amount))
     375  (if (%fxpositive? amount) (%fxshr fx (%fxneg amount))
    371376      (%fxshl fx amount) ) )
    372377
     
    472477        (cond ((%fxzero? fx)
    473478               (%make-string 1 #\0))
    474               ((%fxpositive fx)
     479              ((%fxpositive? fx)
    475480               (let ((str (fx-digits fx 0 0)))
    476481                 (noop str) ; force reference
  • release/4/err5rs-arithmetic/trunk/err5rs-arithmetic-flonums.scm

    r13690 r13706  
    88        (usual-integrations)
    99  (disable-interrupts)
    10         (arithmetic-type generic)
     10        (generic)
    1111        (inline)
    1212        (local)
     
    6969    (values quo (%fp- fpn (%fp* quo fpd))) ) )
    7070
    71 (define-inline (%fpinteger? obj) (and (%flonum obj) (%integer? obj)))
     71(define-inline (%fpinteger? obj) (and (%flonum? obj) (%integer? obj)))
    7272
    7373(define-inline (%fpnan? fp) (not (%fp= fp fp)))
     
    121121;;;
    122122
    123 (module err5rs-arithmetic-bitwise (;export
     123(module err5rs-arithmetic-flonums (;export
    124124  ; ERR5RS
    125125  real->flonum fixnum->flonum
     
    173173;;;
    174174
    175 (define (fl=? fl . fls)
    176         (%fpand-fold 'fl=? *fp=? fl fls) )
    177 
    178 (define (fl<? fl . fls)
    179         (%fpand-fold 'fl<? *fp<? fl fls) )
    180 
    181 (define (fl>? fl . fls)
    182         (%fpand-fold 'fl>? *fp>? fl fls) )
    183 
    184 (define (fl<=? fl . fls)
    185         (%fpand-fold 'fl<=? *fp<=? fl fls) )
    186 
    187 (define (fl>=? fl . fls)
    188         (%fpand-fold 'fl>=? *fp>=? fl fls) )
     175(define (fl=? fp . fps)
     176        (%fpand-fold 'fl=? *fp=? fp fps) )
     177
     178(define (fl<? fp . fps)
     179        (%fpand-fold 'fl<? *fp<? fp fps) )
     180
     181(define (fl>? fp . fps)
     182        (%fpand-fold 'fl>? *fp>? fp fps) )
     183
     184(define (fl<=? fp . fps)
     185        (%fpand-fold 'fl<=? *fp<=? fp fps) )
     186
     187(define (fl>=? fp . fps)
     188        (%fpand-fold 'fl>=? *fp>=? fp fps) )
    189189
    190190(define (flcompare fl1 fl2)
     
    200200               1 ) ) )
    201201
    202 (define (flmax fl . fls)
    203         (%fpfold 'flmax *fpmax fl fls) )
    204 
    205 (define (flmin fl . fls)
    206         (%fpfold 'flmin *fpmin fl fls) )
    207 
    208 (define (flmax-and-min fl . fls)
    209   (%check-flonum 'flmax-and-min fl)
    210         (let loop ((ls fls) (mx fl) (mn fl))
     202(define (flmax fp . fps)
     203        (%fpfold 'flmax *fpmax fp fps) )
     204
     205(define (flmin fp . fps)
     206        (%fpfold 'flmin *fpmin fp fps) )
     207
     208(define (flmax-and-min fp . fps)
     209  (%check-flonum 'flmax-and-min fp)
     210        (let loop ((ls fps) (mx fp) (mn fp))
    211211          (if (%null? ls) (values mx mn)
    212212              (let ((cur (%car ls)))
     
    217217;;;
    218218
    219 (define (flinteger? fl)
    220   (%check-flonum 'flinteger? fl)
    221   (%fpinteger? fl) )
    222 
    223 (define (flzero? fl)
    224   (%check-flonum 'flzero? fl)
    225         (%fp=? 0.0 fl) )
    226 
    227 (define (flpositive? fl)
    228   (%check-flonum 'flpositive? fl)
    229         (%fp<? 0.0 fl) )
    230 
    231 (define (flnegative? fl)
    232   (%check-flonum 'flnegative? fl)
    233         (or (%fp=? -0.0 fl) (%fp<? fl 0.0) ) )
    234 
    235 (define (flodd? fl)
    236   (%check-flonum 'flodd? fl)
    237   (not (%fp=? 0.0 (fpmod fl 2.0))) )
    238 
    239 (define (fleven? fl)
    240   (%check-flonum 'fleven? fl)
    241   (%fp=? 0.0 (fpmod fl 2.0)) )
    242 
    243 (define (flfinite? fl)
    244   (%check-flonum 'flfinite? fl)
    245   (%finite? fl) )
    246 
    247 (define (flinfinite? fl)
    248   (%check-flonum 'flinfinite? fl)
    249   (not (%finite? fl)) )
    250 
    251 (define (flnan? fl)
    252   (%check-flonum 'flnan? fl)
    253   (%fpnan? fl) )
    254 
    255 
    256 ;;;
    257 
    258 (define (fl+ fl . fls)
    259         (%fpfold 'fl+ %fp+ fl fls) )
    260 
    261 (define (fl* fl . fls)
    262         (%fpfold 'fl* %fp* fl fls) )
    263 
    264 (define (fl- fl . fls)
    265   (if (%null? fls) (%fpnegate fl)
    266       (%fpfold 'fl- %fp- fl fls) ) )
    267 
    268 (define (fl/ fl . fls)
    269   (if (%null? fls) (%fp/ 1.0 fl)
    270         (%fpfold 'fl/ %fp/ fl fls) ) )
    271 
    272 (define (flabs fl)
    273   (%check-flonum 'flabs fl)
    274   (%fpabs fl) )
    275 
    276 (define (flfraction fl)
    277   (%check-flonum 'flfraction fl)
    278   (%fpfraction fl) )
    279 
    280 (define (fltruncate fl)
    281   (%check-flonum 'fltruncate fl)
    282   (%fptruncate fl) )
    283 
    284 (define (flfloor fl)
    285   (%check-flonum 'flfloor fl)
    286   (%fpfloor fl) )
    287 
    288 (define (flceiling fl)
    289   (%check-flonum 'flceiling fl)
    290   (%fpceil fl) )
    291 
    292 (define (flround fl)
    293   (%check-flonum 'flround fl)
    294   (%fpround fl) )
    295 
    296 (define (fldiv fln fld)
    297   (%check-flonum 'fldiv fln)
    298   (%check-flonum 'fldiv fld)
    299   (%fpdiv fln fld) )
    300 
    301 (define (flmod fln fld)
    302   (%check-flonum 'flmod fln)
    303   (%check-flonum 'flmod fld)
    304   (%fpmod fln fld) )
    305 
    306 (define (fldiv-and-mod fln fld)
    307   (%check-flonum 'fldiv-and-mod fln)
    308   (%check-flonum 'fldiv-and-mod fld)
    309   (%fpdiv-and-mod  fln fld) )
    310 
    311 (define (fldiv0 fln fld)
    312   (%check-flonum 'fldiv0 fln)
    313   (%check-flonum 'fldiv0 fld)
    314   (%fpdiv0 fln fld) )
    315 
    316 (define (flmod0 fln fld)
    317   (%check-flonum 'flmod0 fln)
    318   (%check-flonum 'flmod0 fld)
    319   (%fpmod0 fln fld) )
    320 
    321 (define (fldiv0-and-mod0 fln fld)
    322   (%check-flonum 'fldiv0-and-mod0 fln)
    323   (%check-flonum 'fldiv0-and-mod0 fld)
    324   (%fpdiv0-and-mod0 fln fld) )
    325 
    326 (define (flexp fl)
    327   (%check-flonum 'flexp fl)
    328   (%fpexp fl) )
    329 
    330 (define (fllog fl #!optional base)
     219(define (flinteger? fp)
     220  (%check-flonum 'flinteger? fp)
     221  (%fpinteger? fp) )
     222
     223(define (flzero? fp)
     224  (%check-flonum 'flzero? fp)
     225        (%fp=? 0.0 fp) )
     226
     227(define (flpositive? fp)
     228  (%check-flonum 'flpositive? fp)
     229        (%fp<? 0.0 fp) )
     230
     231(define (flnegative? fp)
     232  (%check-flonum 'flnegative? fp)
     233        (or (%fp=? -0.0 fp) (%fp<? fp 0.0) ) )
     234
     235(define (flodd? fp)
     236  (%check-flonum 'flodd? fp)
     237  (not (%fp=? 0.0 (fpmod fp 2.0))) )
     238
     239(define (fleven? fp)
     240  (%check-flonum 'fleven? fp)
     241  (%fp=? 0.0 (fpmod fp 2.0)) )
     242
     243(define (flfinite? fp)
     244  (%check-flonum 'flfinite? fp)
     245  (%finite? fp) )
     246
     247(define (flinfinite? fp)
     248  (%check-flonum 'flinfinite? fp)
     249  (not (%finite? fp)) )
     250
     251(define (flnan? fp)
     252  (%check-flonum 'flnan? fp)
     253  (%fpnan? fp) )
     254
     255
     256;;;
     257
     258(define (fl+ fp . fps)
     259        (%fpfold 'fl+ *fp+ fp fps) )
     260
     261(define (fl- fp . fps)
     262  (if (%null? fps) (%fpnegate fp)
     263      (%fpfold 'fl- *fp- fp fps) ) )
     264
     265(define (fl* fp . fps)
     266        (%fpfold 'fl* *fp* fp fps) )
     267
     268(define (fl/ fp . fps)
     269  (if (%null? fps) (%fp/ 1.0 fp)
     270        (%fpfold 'fl/ *fp/ fp fps) ) )
     271
     272(define (flabs fp)
     273  (%check-flonum 'flabs fp)
     274  (%fpabs fp) )
     275
     276(define (flfraction fp)
     277  (%check-flonum 'flfraction fp)
     278  (%fpfraction fp) )
     279
     280(define (fltruncate fp)
     281  (%check-flonum 'fltruncate fp)
     282  (%fptruncate fp) )
     283
     284(define (flfloor fp)
     285  (%check-flonum 'flfloor fp)
     286  (%fpfloor fp) )
     287
     288(define (flceiling fp)
     289  (%check-flonum 'flceiling fp)
     290  (%fpceiling fp) )
     291
     292(define (flround fp)
     293  (%check-flonum 'flround fp)
     294  (%fpround fp) )
     295
     296(define (fldiv fpn fpd)
     297  (%check-flonum 'fldiv fpn)
     298  (%check-flonum 'fldiv fpd)
     299  (%fpdiv fpn fpd) )
     300
     301(define (flmod fpn fpd)
     302  (%check-flonum 'flmod fpn)
     303  (%check-flonum 'flmod fpd)
     304  (%fpmod fpn fpd) )
     305
     306(define (fldiv-and-mod fpn fpd)
     307  (%check-flonum 'fldiv-and-mod fpn)
     308  (%check-flonum 'fldiv-and-mod fpd)
     309  (%fpdiv-and-mod  fpn fpd) )
     310
     311(define (fldiv0 fpn fpd)
     312  (%check-flonum 'fldiv0 fpn)
     313  (%check-flonum 'fldiv0 fpd)
     314  (%fpdiv0 fpn fpd) )
     315
     316(define (flmod0 fpn fpd)
     317  (%check-flonum 'flmod0 fpn)
     318  (%check-flonum 'flmod0 fpd)
     319  (%fpmod0 fpn fpd) )
     320
     321(define (fldiv0-and-mod0 fpn fpd)
     322  (%check-flonum 'fldiv0-and-mod0 fpn)
     323  (%check-flonum 'fldiv0-and-mod0 fpd)
     324  (%fpdiv0-and-mod0 fpn fpd) )
     325
     326(define (flexp fp)
     327  (%check-flonum 'flexp fp)
     328  (%fpexp fp) )
     329
     330(define (fllog fp #!optional base)
    331331  (define log/base  ;memoize log/base functions
    332332    (let ((bases '()))
     
    337337                     (set! bases (alist-cons base func bases))
    338338                     func ) ) ) ) ) )
    339   (%check-flonum 'fllog fl)
    340   (if (not base) (%fplog fl)
     339  (%check-flonum 'fllog fp)
     340  (if (not base) (%fplog fp)
    341341      (begin
    342342        (%check-not-negative 'fllog base)
    343         ((log/base base) fl) ) ) )
    344 
    345 (define (flsin fl)
    346   (%check-flonum 'flsin fl)
    347   (%fpsin fl) )
    348 
    349 (define (flcos fl)
    350   (%check-flonum 'flcos fl)
    351   (%fpcos fl) )
    352 
    353 (define (fltan fl)
    354   (%check-flonum 'fltan fl)
    355   (%fptan fl) )
    356 
    357 (define (flasin fl)
    358   (%check-flonum 'flasin fl)
    359   (%fpasin fl) )
    360 
    361 (define (flacos fl)
    362   (%check-flonum 'flacos fl)
    363   (%fpacos fl) )
    364 
    365 (define (flatan fl #!optional fld)
    366   (%check-flonum 'flatan fl)
    367   (if (not fld) (%fpatan fl)
     343        ((log/base base) fp) ) ) )
     344
     345(define (flsin fp)
     346  (%check-flonum 'flsin fp)
     347  (%fpsin fp) )
     348
     349(define (flcos fp)
     350  (%check-flonum 'flcos fp)
     351  (%fpcos fp) )
     352
     353(define (fltan fp)
     354  (%check-flonum 'fltan fp)
     355  (%fptan fp) )
     356
     357(define (flasin fp)
     358  (%check-flonum 'flasin fp)
     359  (%fpasin fp) )
     360
     361(define (flacos fp)
     362  (%check-flonum 'flacos fp)
     363  (%fpacos fp) )
     364
     365(define (flatan fp #!optional fpd)
     366  (%check-flonum 'flatan fp)
     367  (if (not fpd) (%fpatan fp)
    368368      (begin
    369         (%check-flonum 'flatan fld)
    370         (%fpatan2 fl fld) ) ) )
    371 
    372 (define (flsqrt fl)
    373   (%check-flonum 'flsqrt fl)
    374   (%fpsqrt fl) )
    375 
    376 (define (flexpt fl exp)
    377   (%check-flonum 'flexpt fl)
     369        (%check-flonum 'flatan fpd)
     370        (%fpatan2 fp fpd) ) ) )
     371
     372(define (flsqrt fp)
     373  (%check-flonum 'flsqrt fp)
     374  (%fpsqrt fp) )
     375
     376(define (flexpt fp exp)
     377  (%check-flonum 'flexpt fp)
    378378  (%check-flonum 'flexpt exp)
    379   (if (%fp= 2.0 fl) (ldexp 1.0 exp)
    380       (%expt fl exp) ) )
    381 
    382 (define (flnumerator fl)
    383   (%check-flonum 'flnumerator fl)
    384   fl )
    385 
    386 (define (fldenominator fl)
    387   (%check-flonum 'fldenominator fl)
    388   (if (%fpnan? fl) fl
     379  (if (%fp= 2.0 fp) (ldexp 1.0 exp)
     380      (%expt fp exp) ) )
     381
     382(define (flnumerator fp)
     383  (%check-flonum 'flnumerator fp)
     384  fp )
     385
     386(define (fldenominator fp)
     387  (%check-flonum 'fldenominator fp)
     388  (if (%fpnan? fp) fp
    389389      1.0 ) )
    390390
     
    392392;;; Extras
    393393
    394 (define (flnegate fl)
    395   (%check-flonum 'flnegate fl)
    396   (%fpnegate fl) )
    397 
    398 ) ;module err5rs-arithmetic-bitwise
     394(define (flnegate fp)
     395  (%check-flonum 'flnegate fp)
     396  (%fpnegate fp) )
     397
     398) ;module err5rs-arithmetic-flonums
Note: See TracChangeset for help on using the changeset viewer.