From b8c328b55833fd91b149c8f160230cef14a59a24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 15 May 2019 14:09:13 +0200 Subject: [PATCH] coerce: allow coercing to si:complex-*-float Previously coerce didn't understand these atomic specifiers. --- src/cmp/cmpopt.lsp | 18 ++++++++++++++++-- src/lsp/predlib.lsp | 12 ++++++++++++ 2 files changed, 28 insertions(+), 2 deletions(-) diff --git a/src/cmp/cmpopt.lsp b/src/cmp/cmpopt.lsp index cb5485489..1cd195d8e 100644 --- a/src/cmp/cmpopt.lsp +++ b/src/cmp/cmpopt.lsp @@ -215,13 +215,27 @@ (single-float . (float x 0.0f0)) (double-float . (float x 0.0d0)) (long-float . (float x 0.0l0)) + #+complex-float + (si:complex-single-float . (let ((y x)) + (declare (:read-only y)) + (complex (float (realpart y) 0.0f0) + (float (imagpart y) 0.0f0)))) + #+complex-float + (si:complex-double-float . (let ((y x)) + (declare (:read-only y)) + (complex (float (realpart y) 0.0d0) + (float (imagpart y) 0.0d0)))) + #+complex-float + (si:complex-long-float . (let ((y x)) + (declare (:read-only y)) + (complex (float (realpart y) 0.0l0) + (float (imagpart y) 0.0l0)))) (complex . (let ((y x)) (declare (:read-only y)) (complex (realpart y) (imagpart y)))) (base-char . (character x)) (character . (character x)) - (function . (si::coerce-to-function x)) - )) + (function . (si::coerce-to-function x)))) (defun expand-coerce (form value type env) (declare (si::c-local)) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 3dff9de5a..013af50d5 100644 --- a/src/lsp/predlib.lsp +++ b/src/lsp/predlib.lsp @@ -768,6 +768,18 @@ if not possible." (DOUBLE-FLOAT (float object 0.0D0)) (LONG-FLOAT (float object 0.0L0)) (COMPLEX (complex (realpart object) (imagpart object))) + #+complex-float + (si:complex-single-float + (complex (coerce (realpart object) 'single-float) + (coerce (imagpart object) 'single-float))) + #+complex-float + (si:complex-double-float + (complex (coerce (realpart object) 'double-float) + (coerce (imagpart object) 'double-float))) + #+complex-float + (si:complex-long-float + (complex (coerce (realpart object) 'long-float) + (coerce (imagpart object) 'long-float))) (FUNCTION (coerce-to-function object)) ((VECTOR SIMPLE-VECTOR #+unicode SIMPLE-BASE-STRING SIMPLE-STRING #+unicode BASE-STRING STRING BIT-VECTOR SIMPLE-BIT-VECTOR)