foreign-array/complex-types.lisp

   1 ;; Complex number types
   2 ;; Liam Healy 2009-01-13 21:24:05EST complex-types.lisp
   3 ;; Time-stamp: <2011-10-16 23:30:25EDT complex-types.lisp>
   4 ;;
   5 ;; Copyright 2009, 2010 Liam M. Healy
   6 ;; Distributed under the terms of the GNU General Public License
   7 ;;
   8 ;; This program is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12 ;;
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17 ;;
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (in-package :grid)
  22
  23 (export '(complex-double-c complex-float-c component-float-type component-type))
  24
  25 ;;;;****************************************************************************
  26 ;;;; Complex types
  27 ;;;;****************************************************************************
  28
  29 (cffi:defcstruct (complex-float-c :class complex-float-type)
  30   (dat :float :count 2))
  31
  32 (defmethod cffi:translate-into-foreign-memory ((value complex) (type complex-float-type) p)
  33   (cffi:with-foreign-slots ((dat) p (:struct complex-float-c))
  34     (setf (cffi:mem-aref dat :float 0) (realpart value)
  35           (cffi:mem-aref dat :float 1) (imagpart value))))
  36
  37 (defmethod cffi:translate-from-foreign (p (type complex-float-type))
  38   (cffi:with-foreign-slots ((dat) p (:struct complex-float-c))
  39     (complex (cffi:mem-aref dat :float 0)
  40              (cffi:mem-aref dat :float 1))))
  41
  42 (cffi:defcstruct (complex-double-c :class complex-double-type)
  43   (dat :double :count 2))
  44
  45 (defmethod cffi:translate-into-foreign-memory ((value complex) (type complex-double-type) p)
  46   (cffi:with-foreign-slots ((dat) p (:struct complex-double-c))
  47     (setf (cffi:mem-aref dat :double 0) (realpart value)
  48           (cffi:mem-aref dat :double 1) (imagpart value))))
  49
  50 (defmethod cffi:translate-from-foreign (p (type complex-double-type))
  51   (cffi:with-foreign-slots ((dat) p (:struct complex-double-c))
  52     (complex (cffi:mem-aref dat :double 0)
  53              (cffi:mem-aref dat :double 1))))
  54
  55 #+long-double
  56 (cffi:defcstruct complex-long-double-c
  57   (dat :long-double :count 2))
  58
  59 (defun clean-type (type)
  60   ;; SBCL (and possibly other implementations) specifies limits on the type, e.g.
  61   ;; (type-of #C(1.0 2.0))
  62   ;; (COMPLEX (DOUBLE-FLOAT 1.0 2.0))
  63   ;; This cleans that up to make
  64   ;; (clean-type (type-of #C(1.0 2.0)))
  65   ;; (COMPLEX DOUBLE-FLOAT)
  66   (if (and (subtypep type 'complex) (listp (second type)))
  67       (list (first type) (first (second type)))
  68       type))
  69
  70 (defun component-float-type (eltype)
  71   "The type of the component of this type (complex)."
  72   (if (subtypep eltype 'complex)
  73       ;; complex: use the component type
  74       (second eltype)
  75       eltype))
  76
  77 (defun component-type (eltype)
  78   (cl-cffi (component-float-type eltype)))
  79