|
46 | 46 | (define (ival-sub x y) |
47 | 47 | (ival-sub! (new-ival) x y)) |
48 | 48 |
|
49 | | -(define (epmul! out a-endpoint b-endpoint a-class b-class) |
| 49 | +(define (epmul! out a-endpoint b-endpoint a-class b-class rnd) |
50 | 50 | (match-define (endpoint a a!) a-endpoint) |
51 | 51 | (match-define (endpoint b b!) b-endpoint) |
52 | 52 | (define a0 (bfzero? a)) |
|
57 | 57 | [(or a0 b0) |
58 | 58 | (mpfr-set! out 0.bf 'nearest) |
59 | 59 | #t] |
60 | | - [else (= 0 (mpfr-mul! out a b (bf-rounding-mode)))])) |
| 60 | + [else (= 0 (mpfr-mul! out a b rnd))])) |
61 | 61 | (endpoint out |
62 | 62 | (or (and a! b! exact?) |
63 | 63 | (and a! a0) |
|
76 | 76 |
|
77 | 77 | (define (mkmult out a b c d) |
78 | 78 | (match-define (ival (endpoint rlo _) (endpoint rhi _) _ _) out) |
79 | | - (ival (rnd 'down epmul! rlo a b x-sign y-sign) |
80 | | - (rnd 'up epmul! rhi c d x-sign y-sign) |
| 79 | + (ival (epmul! rlo a b x-sign y-sign 'down) |
| 80 | + (epmul! rhi c d x-sign y-sign 'up) |
81 | 81 | (or xerr? yerr?) |
82 | 82 | (or xerr yerr))) |
83 | 83 |
|
|
102 | 102 | (mpfr-set! (ival-hi-val out) hi 'up) ; should be exact |
103 | 103 | (ival (endpoint (ival-lo-val out) lo!) (endpoint (ival-hi-val out) hi!) err? err)])) |
104 | 104 |
|
105 | | -(define (epdiv! out a-endpoint b-endpoint a-class) |
| 105 | +(define (epdiv! out a-endpoint b-endpoint a-class rnd) |
106 | 106 | (match-define (endpoint a a!) a-endpoint) |
107 | 107 | (match-define (endpoint b b!) b-endpoint) |
108 | 108 | (mpfr-set-prec! out (bf-precision)) |
109 | | - (define exact? (= 0 (mpfr-div! out a b (bf-rounding-mode)))) |
| 109 | + (define exact? (= 0 (mpfr-div! out a b rnd))) |
110 | 110 | (endpoint out |
111 | 111 | (or (and a! b! exact?) |
112 | 112 | (and a! (bfzero? a)) |
|
124 | 124 | (define y-class (classify-ival-strict y)) |
125 | 125 |
|
126 | 126 | (define (mkdiv a b c d) |
127 | | - (ival (rnd 'down epdiv! rlo a b x-class) (rnd 'up epdiv! rhi c d x-class) err? err)) |
| 127 | + (ival (epdiv! rlo a b x-class 'down) (epdiv! rhi c d x-class 'up) err? err)) |
128 | 128 |
|
129 | 129 | (match* (x-class y-class) |
130 | 130 | [(_ 0) ; In this case, y stradles 0 |
|
0 commit comments