diff options
| author | Stas Boukarev <stassats@gmail.com> | 2024-09-19 21:55:50 +0300 |
|---|---|---|
| committer | Stas Boukarev <stassats@gmail.com> | 2024-09-19 21:56:32 +0300 |
| commit | f24e888f2dc4dbca7655dcfd1acbb028fb282fc5 (patch) | |
| tree | ebdda4d1306572e32a1d3f187c819d65de19dc52 | |
| parent | 2933d9454da017fac4a3307f2bdc23a8ea5d3d36 (diff) | |
Transform (= small-int float) and not just (= float small-int).
| -rw-r--r-- | src/compiler/float-tran.lisp | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 109c3ea35..e2b1d86d2 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2100,6 +2100,34 @@ (def <=) (def >=)) +(macrolet ((def (op) + `(deftransform ,op ((y x) ((integer #.most-negative-exactly-single-float-integer + #.most-positive-exactly-single-float-integer) + float) + * :node node :important nil + :policy (> speed 1)) + (unless (and (types-equal-or-intersect (lvar-type x) (specifier-type 'double-float)) + (types-equal-or-intersect (lvar-type x) (specifier-type 'single-float))) + (give-up-ir1-transform)) + (delay-ir1-transform node :ir1-phases) + (if (csubtypep (lvar-type y) (specifier-type 'float)) + (let ((y (lvar-value y))) + (if (and (safe-single-coercion-p y) + (sb-xc:= y (coerce y 'single-float)) + (sb-xc:= y (coerce y 'double-float))) + `(if (single-float-p x) + (,',op (truly-the single-float x) ,(coerce y 'single-float)) + (,',op (truly-the double-float x) ,(coerce y 'double-float))) + (give-up-ir1-transform))) + `(if (single-float-p x) + (,',op (truly-the single-float x) (%single-float y)) + (,',op (truly-the double-float x) (%double-float y))))))) + (def =) + (def <) + (def >) + (def <=) + (def >=)) + (deftransform phase ((n)) (splice-fun-args n 'complex 2) `(lambda (x y) |