diff options
| author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2017-03-09 15:13:19 +0100 |
|---|---|---|
| committer | Daniel Llorens <daniel.llorens@bluewin.ch> | 2017-03-09 15:17:35 +0100 |
| commit | 7de77bf7d8016446b4fcddb36e588406266ec40a (patch) | |
| tree | c8e3cac8b096be23938a5b8dde366197eb848c09 /module | |
| parent | 7cdfaaada9a9c5a491c393be4cfd475fe61637b8 (diff) | |
Fix bug in comparison between real and complex
This bug was introduced by 35a90592501ebde7e7ddbf2486ca9d315e317d09.
* module/language/cps/specialize-numbers.scm (specialize-operations):
Check that both operands are real as a condition for
specialize-f64-comparison.
* test-suite/tests/numbers.test: Add test.
Diffstat (limited to 'module')
| -rw-r--r-- | module/language/cps/specialize-numbers.scm | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index 808ea6705..d5587037b 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -51,6 +51,7 @@ (define-module (language cps specialize-numbers) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (language cps) #:use-module (language cps intmap) #:use-module (language cps intset) @@ -301,11 +302,12 @@ BITS indicating the significant bits needed for a variable. BITS may be (lambda (type min max) (and (eqv? type &exact-integer) (<= 0 min max #xffffffffffffffff)))))) - (define (f64-operand? var) - (call-with-values (lambda () - (lookup-pre-type types label var)) - (lambda (type min max) - (and (eqv? type &flonum))))) + (define (f64-operands? vara varb) + (let-values (((typea mina maxa) (lookup-pre-type types label vara)) + ((typeb minb maxb) (lookup-pre-type types label varb))) + (and (zero? (logand (logior typea typeb) (lognot &real))) + (or (eqv? typea &flonum) + (eqv? typeb &flonum))))) (match cont (($ $kfun) (let ((types (infer-types cps label))) @@ -411,7 +413,7 @@ BITS indicating the significant bits needed for a variable. BITS may be ($ $branch kt ($ $primcall (and op (or '< '<= '= '>= '>)) (a b))))) (values (cond - ((or (f64-operand? a) (f64-operand? b)) + ((f64-operands? a b) (with-cps cps (let$ body (specialize-f64-comparison k kt src op a b)) (setk label ($kargs names vars ,body)))) |