Coverage report: /development/source/library/org/datagraph/spocq-shard/src/core/patches/sbcl-20150825.lisp

KindCoveredAll%
expression4857 84.2
branch24 50.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- package: sb-kernel; -*-
2
 
3
 (in-package :sb-kernel)
4
 
5
 ;; ensure that truncate treats unity rationals as whole
6
 
7
 (SB-EXT:WITHOUT-PACKAGE-LOCKS
8
 
9
 (defun truncate (number &optional (divisor 1))
10
   (macrolet ((truncate-float (rtype)
11
                `(let* ((float-div (coerce divisor ',rtype))
12
                        (res (%unary-truncate (/ number float-div))))
13
                   (values res
14
                           (- number
15
                              (* (coerce res ',rtype) float-div))))))
16
     (number-dispatch ((number real) (divisor real))
17
       ((fixnum fixnum) (truncate number divisor))
18
       (((foreach fixnum bignum) ratio)
19
        (let ((q (truncate (* number (denominator divisor))
20
                           (numerator divisor))))
21
          (values q (- number (* q divisor)))))
22
       ((fixnum bignum)
23
        (bignum-truncate (make-small-bignum number) divisor))
24
       ((ratio (or float rational))
25
        (when (eql (denominator number) 1)
26
          (setf number (numerator number)))
27
        (let ((q (truncate (numerator number)
28
                           (* (denominator number) divisor))))
29
          (values q (- number (* q divisor)))))
30
       ((bignum fixnum)
31
        (bignum-truncate number (make-small-bignum divisor)))
32
       ((bignum bignum)
33
        (bignum-truncate number divisor))
34
 
35
       (((foreach single-float double-float)
36
         (or rational single-float))
37
        (if (eql divisor 1)
38
            (let ((res (%unary-truncate number)))
39
              (values res (- number (coerce res '(dispatch-type number)))))
40
            (truncate-float (dispatch-type number))))
41
       ((double-float (or single-float double-float))
42
        (truncate-float double-float))
43
       ((single-float double-float)
44
        (truncate-float double-float))
45
       (((foreach fixnum bignum ratio)
46
         (foreach single-float double-float))
47
        (truncate-float (dispatch-type divisor))))))
48
 
49
 )