Commit 18e08e4e authored by Liam M. Healy's avatar Liam M. Healy

Foreign structure with CFFI's new syntax

Specify the foreign structures with CFFI's new syntax, (:struct foo),
and fix #'creturn-st so that it will not take :struct (or any other
keyword) as a return variable name.  GSLL now compiles and loads
without error or warning, but it has not been tested.
parent 121e475d
;; Expand the body of a defmfun
;; Liam Healy 2009-04-13 22:07:13EDT body-expand.lisp
;; Time-stamp: <2011-10-29 18:52:05EDT body-expand.lisp>
;; Time-stamp: <2011-10-30 00:35:29EDT body-expand.lisp>
;;
;; Copyright 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -22,13 +22,16 @@
(defun creturn-st (c-return)
"The symbol-type of the return from the C function."
(grid:make-st
(if (listp c-return)
(grid:st-symbol c-return)
(make-symbol "CRETURN"))
(if (member c-return *special-c-return*)
:int
(if (listp c-return) (grid:st-type c-return) c-return))))
(let ((supplied-symbol-p ; return symbol supplied
(and (listp c-return) ; accommodate (:struct foo) type spec
(not (eq (symbol-package (first c-return)) (find-package :keyword))))))
(grid:make-st
(if supplied-symbol-p
(grid:st-symbol c-return)
(make-symbol "CRETURN"))
(if (member c-return *special-c-return*)
:int
(if supplied-symbol-p (grid:st-type c-return) c-return)))))
(defun cl-convert-form (decl)
"Generate a form that calls the appropriate converter from C/GSL to CL."
......
;; Functions of complex numbers
;; Liam Healy 2009-01-13 21:19:38EST complex.lisp
;; Time-stamp: <2010-06-27 18:03:16EDT complex.lisp>
;; Time-stamp: <2011-10-29 23:20:40EDT complex.lisp>
;;
;; Copyright 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -28,26 +28,26 @@
(defmfun argument (number)
"gsl_complex_arg"
((number grid:complex-double-c))
((number (:struct grid:complex-double-c)))
:c-return :double
:documentation
"The angle of the complex number.")
(defmfun modulus (number)
"gsl_complex_abs"
((number grid:complex-double-c))
((number (:struct grid:complex-double-c)))
:c-return :double
:documentation "The magnitude, or modulus of the complex number.")
(defmfun modulus2 (number)
"gsl_complex_abs2"
((number grid:complex-double-c))
((number (:struct grid:complex-double-c)))
:c-return :double
:documentation "The magnitude squared of the complex number.")
(defmfun log-modulus (number)
"gsl_complex_logabs"
((number grid:complex-double-c))
((number (:struct grid:complex-double-c)))
:c-return :double
:documentation "The logarithm of the magnitude of the complex number.")
......@@ -61,78 +61,78 @@
(defmfun cx-add (c1 c2)
"gsl_complex_add"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sub (c1 c2)
"gsl_complex_sub"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-mul (c1 c2)
"gsl_complex_mul"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-div (c1 c2)
"gsl_complex_div"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-add-real (c1 num)
"gsl_complex_add_real"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sub-real (c1 num)
"gsl_complex_sub_real"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-mul-real (c1 num)
"gsl_complex_mul_real"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-div-real (c1 num)
"gsl_complex_div_real"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-add-imag (c1 num)
"gsl_complex_add_imag"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sub-imag (c1 num)
"gsl_complex_sub_imag"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-mul-imag (c1 num)
"gsl_complex_mul_imag"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-div-imag (c1 num)
"gsl_complex_div_imag"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-conjugate (c1)
"gsl_complex_conjugate"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-inverse (c1)
"gsl_complex_inverse"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-negative (c1)
"gsl_complex_negative"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;;;;****************************************************************************
;;; Complex functions
......@@ -144,43 +144,43 @@
(defmfun cx-sqrt (c1)
"gsl_complex_sqrt"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sqrt-real (num)
"gsl_complex_sqrt_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-expt (c1 c2)
"gsl_complex_pow"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-expt-real (c1 num)
"gsl_complex_pow_real"
((c1 grid:complex-double-c) (num :double))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (num :double))
:c-return (:struct grid:complex-double-c))
(defmfun cx-exp (c1)
"gsl_complex_exp"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-log (c1)
"gsl_complex_log"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-log10 (c1)
"gsl_complex_log10"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-logb (c1 c2)
"gsl_complex_log_b"
((c1 grid:complex-double-c) (c2 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)) (c2 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;;;;****************************************************************************
;;; Trigonometric functions
......@@ -192,33 +192,33 @@
(defmfun cx-sin (c1)
"gsl_complex_sin"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-cos (c1)
"gsl_complex_cos"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sec (c1)
"gsl_complex_sec"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-csc (c1)
"gsl_complex_csc"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-tan (c1)
"gsl_complex_tan"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-cot (c1)
"gsl_complex_cot"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;;;;****************************************************************************
;;; Inverse trigonometric functions
......@@ -230,53 +230,53 @@
(defmfun cx-arcsin (c1)
"gsl_complex_arcsin"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arcsin-real (num)
"gsl_complex_arcsin_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccos (c1)
"gsl_complex_arccos"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccos-real (num)
"gsl_complex_arccos_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arcsec (c1)
"gsl_complex_arcsec"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arcsec-real (num)
"gsl_complex_arcsec_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccsc (c1)
"gsl_complex_arccsc"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccsc-real (num)
"gsl_complex_arccsc_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arctan (c1)
"gsl_complex_arctan"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccot (c1)
"gsl_complex_arccot"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;;;;****************************************************************************
;;; Hyperbolic functions
......@@ -284,33 +284,33 @@
(defmfun cx-sinh (c1)
"gsl_complex_sinh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-cosh (c1)
"gsl_complex_cosh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-sech (c1)
"gsl_complex_sech"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-csch (c1)
"gsl_complex_csch"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-tanh (c1)
"gsl_complex_tanh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-coth (c1)
"gsl_complex_coth"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;;;;****************************************************************************
;;; Inverse trigonometric functions
......@@ -318,40 +318,40 @@
(defmfun cx-arcsinh (c1)
"gsl_complex_arcsinh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccosh (c1)
"gsl_complex_arccosh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccosh-real (num)
"gsl_complex_arccosh_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arcsech (c1)
"gsl_complex_arcsech"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccsch (c1)
"gsl_complex_arccsch"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arctanh (c1)
"gsl_complex_arctanh"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
(defmfun cx-arctanh-real (num)
"gsl_complex_arctanh_real"
((num :double))
:c-return grid:complex-double-c)
:c-return (:struct grid:complex-double-c))
(defmfun cx-arccoth (c1)
"gsl_complex_arccoth"
((c1 grid:complex-double-c))
:c-return grid:complex-double-c)
((c1 (:struct grid:complex-double-c)))
:c-return (:struct grid:complex-double-c))
;; Polynomials
;; Liam Healy, Tue Mar 21 2006 - 18:33
;; Time-stamp: <2011-01-10 17:47:56EST polynomial.lisp>
;; Time-stamp: <2011-10-29 23:21:19EDT polynomial.lisp>
;;
;; Copyright 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -47,11 +47,11 @@
&key)
"gsl_poly_complex_eval"
(((grid:foreign-pointer coefficients) :pointer) ((dim0 coefficients) sizet)
(x grid:complex-double-c))
(x (:struct grid:complex-double-c)))
:definition :method
:gsl-version (1 11)
:inputs (coefficients)
:c-return grid:complex-double-c
:c-return (:struct grid:complex-double-c)
:documentation ; FDL
"Evaluate the polyonomial with coefficients at the complex value x.")
......@@ -61,11 +61,11 @@
&key)
"gsl_complex_poly_complex_eval"
(((grid:foreign-pointer coefficients) :pointer) ((dim0 coefficients) sizet)
(x grid:complex-double-c))
(x (:struct grid:complex-double-c)))
:definition :method
:gsl-version (1 11)
:inputs (coefficients)
:c-return grid:complex-double-c
:c-return (:struct grid:complex-double-c)
:documentation ; FDL
"Evaluate the polyonomial with coefficients at the complex value x.")
......@@ -128,7 +128,8 @@
(defmfun solve-quadratic-complex (a b c)
"gsl_poly_complex_solve_quadratic"
((a :double) (b :double) (c :double)
(root1 (:pointer grid:complex-double-c)) (root2 (:pointer grid:complex-double-c)))
(root1 (:pointer (:struct grid:complex-double-c)))
(root2 (:pointer (:struct grid:complex-double-c))))
:c-return :number-of-answers
:documentation ; FDL
"The complex roots of the quadratic equation a x^2 + b x + c = 0.
......@@ -154,8 +155,9 @@
(defmfun solve-cubic-complex (a b c)
"gsl_poly_complex_solve_cubic"
((a :double) (b :double) (c :double)
(root1 (:pointer grid:complex-double-c)) (root2 (:pointer grid:complex-double-c))
(root3 (:pointer grid:complex-double-c)))
(root1 (:pointer (:struct grid:complex-double-c)))
(root2 (:pointer (:struct grid:complex-double-c)))
(root3 (:pointer (:struct grid:complex-double-c))))
:c-return :number-of-answers
:documentation ; FDL
"Find the complex roots of the cubic equation, x^3 + a x^2 + b x + c = 0
......
;; Airy functions
;; Liam Healy, Fri Mar 17 2006 - 18:41
;; Time-stamp: <2009-12-27 10:10:07EST airy.lisp>
;; Time-stamp: <2011-10-29 23:30:34EDT airy.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -25,69 +25,77 @@
;;;;****************************************************************************
(defmfun airy-Ai (x &optional (mode :double))
"gsl_sf_airy_Ai_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Ai_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The Airy function Ai(x).")
(defmfun airy-Bi (x &optional (mode :double))
"gsl_sf_airy_Bi_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Bi_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The Airy function Bi(x).")
(defmfun airy-Ai-scaled (x &optional (mode :double))
"gsl_sf_airy_Ai_scaled_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Ai_scaled_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The scaled Airy function S_A(x) Ai(x).
For x>0 the scaling factor S_A(x) is \exp(+(2/3) x^(3/2)),
and is 1 for x<0.")
(defmfun airy-Bi-scaled (x &optional (mode :double))
"gsl_sf_airy_Bi_scaled_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Bi_scaled_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The scaled Airy function S_B(x) Bi(x).
For x>0 the scaling factor S_B(x) is exp(-(2/3) x^(3/2)),
and is 1 for x<0.")
(defmfun airy-Ai-deriv (x &optional (mode :double))
"gsl_sf_airy_Ai_deriv_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Ai_deriv_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The Airy function derivative Ai'(x).")
(defmfun airy-Bi-deriv (x &optional (mode :double))
"gsl_sf_airy_Bi_deriv_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Bi_deriv_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation "The Airy function derivative Bi'(x).")
(defmfun airy-Ai-deriv-scaled (x &optional (mode :double))
"gsl_sf_airy_Ai_deriv_scaled_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Ai_deriv_scaled_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The scaled Airy function derivative S_A(x) Ai'(x).
For x>0 the scaling factor S_A(x) is exp(+(2/3) x^(3/2)),
and is 1 for x<0.")
(defmfun airy-Bi-deriv-scaled (x &optional (mode :double))
"gsl_sf_airy_Bi_deriv_scaled_e" ((x :double) (mode sf-mode) (ret sf-result))
"gsl_sf_airy_Bi_deriv_scaled_e"
((x :double) (mode sf-mode) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The scaled Airy function derivative S_B(x) Bi'(x).
For x>0 the scaling factor S_B(x) is
exp(-(2/3) x^(3/2)), and is 1 for x<0.")
(defmfun airy-zero-Ai (s)
"gsl_sf_airy_zero_Ai_e" ((s sizet) (ret sf-result))
"gsl_sf_airy_zero_Ai_e" ((s sizet) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The location of the s-th zero of the Airy function Ai(x).")
(defmfun airy-zero-Bi (s)
"gsl_sf_airy_zero_Bi_e" ((s sizet) (ret sf-result))
"gsl_sf_airy_zero_Bi_e" ((s sizet) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The location of the s-th zero of the Airy function Bi(x).")
(defmfun airy-zero-Ai-deriv (s)
"gsl_sf_airy_zero_Ai_deriv_e" ((s sizet) (ret sf-result))
"gsl_sf_airy_zero_Ai_deriv_e" ((s sizet) (ret (:pointer (:struct sf-result))))
:documentation ; FDL
"The location of the s-th zero of the Airy function derivative Ai'(x).")
(defmfun airy-zero-Bi-deriv (s)
"gsl_sf_airy_zero_Bi_deriv_e" ((s sizet) (ret sf-result))
"gsl_sf_airy_zero_Bi_deriv_e" ((s sizet) (ret (:pointer (:struct sf-result))))