Skip to content
Snippets Groups Projects
Commit 639a5f35 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Eliminate fsbv:object for built-in types

Eliminate fsbv:object for built-in types; started conversion of
special function result (sf-result*) structures but this requires a
modification to CFFI.  Simulated annealing structure called by value.
Use cffi-fsbv's sizet definition; this imposes a dependence on that
system.  No compilation attempted yet.
parent acb52420
No related branches found
No related tags found
No related merge requests found
;; Expand the body of a defmfun
;; Liam Healy 2009-04-13 22:07:13EDT body-expand.lisp
;; Time-stamp: <2010-12-16 11:46:22EST body-expand.lisp>
;; Time-stamp: <2011-10-23 22:06:16EDT body-expand.lisp>
;;
;; Copyright 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -84,7 +84,7 @@
(defun cl-convert-form (decl)
"Generate a form that calls the appropriate converter from C/GSL to CL."
(list `(fsbv:object ,(grid:st-symbol decl) ',(grid:st-actual-type decl))))
(list `(cffi:mem-ref ,(grid:st-symbol decl) ',(grid:st-actual-type decl))))
(defun values-unless-singleton (forms)
(unless (listp forms) (error "Values are not a list."))
......
;; Generate a lambda that calls the user function; will be called by callback.
;; Liam Healy
;; Time-stamp: <2011-10-23 20:25:24EDT funcallable.lisp>
;; Time-stamp: <2011-10-23 22:10:08EDT funcallable.lisp>
;;
;; Copyright 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -97,7 +97,8 @@
,@(affi::delinearize-index
(affi:make-affi (value-from-dimensions argspec dimension-values))
linear-index))
`(fsbv:object
;; Would this be better replaced with grid:faref?
`(cffi:mem-aref
,foreign-pointer-name
',(parse-callback-argspec argspec 'element-type)
,linear-index))
......
;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53
;; Time-stamp: <2011-10-17 23:09:40EDT init.lisp>
;; Time-stamp: <2011-10-23 21:57:41EDT init.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -22,6 +22,7 @@
(:nicknames :gsl)
(:use :common-lisp :cffi)
(:import-from :grid #:dim0 #:dim1 #:^ #:copy)
#+fsbv (:import-from :cffi-fsbv #:sizet) ; and what do we do if #-fsbv?
(:export #:dim0 #:dim1 #:copy)
;; No actual conflict due to different usage of symbols:
;; antik:psi means "pounds per square inch" vs. function #'gsl:psi
......
;; Number types used by GSL functions, and specification conversion
;; Liam Healy 2008-12-31 21:06:34EST types.lisp
;; Time-stamp: <2010-12-19 11:42:56EST types.lisp>
;; Time-stamp: <2011-10-23 20:54:45EDT types.lisp>
;;
;; Copyright 2008, 2009, 2010 Liam M. Healy
;; Copyright 2008, 2009, 2010, 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
......@@ -21,18 +21,12 @@
(in-package :gsl)
;;;;****************************************************************************
;;;; Unsigned address types size_t
;;;; Word size
;;;;****************************************************************************
(fsbv:defconvert (sizet :constructor values))
(case (cffi:foreign-type-size :long)
(8
(push :int64 *features*)
#+fsbv (fsbv:define-equivalent-type sizet :uint64))
(4
(push :int32 *features*)
#+fsbv (fsbv:define-equivalent-type sizet :uint32)))
(8 (push :int64 *features*)
(4 (push :int32 *features*))))
;;;;****************************************************************************
;;;; Type specification conversion
......
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2010-12-19 16:11:01EST generators.lisp>
;; Time-stamp: <2011-10-23 22:02:24EDT generators.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -169,7 +169,7 @@
(loop for i from 0 below (length ans)
do
(setf (aref ans i)
(fsbv:object (rng-state gen) :uint8 i)))
(cffi:mem-aref (rng-state gen) :uint8 i)))
ans))
;;;;****************************************************************************
......
;; Linear least squares, or linear regression
;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp>
;; Time-stamp: <2011-10-23 20:31:38EDT linear-least-squares.lisp>
;; Time-stamp: <2011-10-23 21:55:39EDT linear-least-squares.lisp>
;;
;; Copyright 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -202,7 +202,7 @@
:inputs (model weight observations)
:outputs (parameters covariance)
:switch (weight)
:return (parameters covariance (fsbv:object chisq :double))
:return (parameters covariance (cffi:mem-ref chisq :double))
:export nil
:index linear-mfit
:documentation ; FDL
......@@ -247,7 +247,7 @@
:inputs (model weight observations)
:outputs (parameters covariance)
:switch (weight)
:return ((fsbv:object chisq :double) (fsbv:object rank 'sizet))
:return ((cffi:mem-ref chisq :double) (cffi:mem-ref rank 'sizet))
:export nil
:index linear-mfit
:documentation ; FDL
......
;; Simulated Annealing
;; Liam Healy Sun Feb 11 2007 - 17:23
;; Time-stamp: <2011-05-26 12:37:32EDT simulated-annealing.lisp>
;; Time-stamp: <2011-10-23 22:15:00EDT simulated-annealing.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -26,7 +26,7 @@
;;;; Simulated annealing argument structure
;;;;****************************************************************************
(fsbv:defcstruct simulated-annealing-parameters
(cffi:defcstruct simulated-annealing-parameters
(n-tries :int) ; how many points to try for each step
(iterations-fixed-T :int) ; how many iterations at each temperature?
(step-size :double) ; max step size in the random walk
......@@ -181,7 +181,7 @@
((cffi:get-callback 'sa-copy-constructor-function) :pointer)
((cffi:get-callback 'sa-destroy-function) :pointer)
(0 sizet)
(parameters simulated-annealing-parameters))
(parameters (:struct simulated-annealing-parameters)))
:c-return :void
:export nil
:index simulated-annealing)
......
;; Coulumb functions
;; Liam Healy, Sat Mar 18 2006 - 23:23
;; Time-stamp: <2011-10-23 20:32:16EDT coulomb.lisp>
;; Time-stamp: <2011-10-23 22:04:09EDT coulomb.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -56,8 +56,8 @@
(values-list
(append (subseq vl 0 4)
(list
(fsbv:object exp-F :double)
(fsbv:object exp-G :double))
(cffi:mem-aref exp-F :double)
(cffi:mem-aref exp-G :double))
(subseq vl 4)))))
:documentation ; FDL
"The Coulomb wave functions F_L(\eta,x),
......@@ -76,7 +76,7 @@
((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double)
((grid:foreign-pointer fc-array) :pointer) (F-exponent (:pointer :double)))
:outputs (fc-array)
:return (fc-array (fsbv:object F-exponent :double))
:return (fc-array (cffi:mem-ref F-exponent :double))
:documentation ; FDL
"The Coulomb wave function F_L(\eta,x) for
L = Lmin ... Lmin + kmax, storing the results in fc-array.
......@@ -95,8 +95,8 @@
:outputs (fc-array gc-array)
:return (fc-array
gc-array
(fsbv:object F-exponent :double)
(fsbv:object G-exponent :double))
(cffi:mem-ref F-exponent :double)
(cffi:mem-ref G-exponent :double))
:documentation ; FDL
"The functions F_L(\eta,x),
G_L(\eta,x) for L = Lmin ... Lmin + kmax storing the
......@@ -121,7 +121,7 @@
:outputs (fc-array fcp-array gc-array gcp-array)
:return
(fc-array fcp-array gc-array gcp-array
(fsbv:object F-exponent :double) (fsbv:object G-exponent :double))
(cffi:mem-ref F-exponent :double) (cffi:mem-ref G-exponent :double))
:documentation ; FDL
"The functions F_L(\eta,x),
G_L(\eta,x) and their derivatives F'_L(\eta,x),
......@@ -137,7 +137,7 @@
((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double)
((grid:foreign-pointer fc-array) :pointer) (F-exponent (:pointer :double)))
:outputs (fc-array)
:return (fc-array (fsbv:object F-exponent :double))
:return (fc-array (cffi:mem-ref F-exponent :double))
:documentation ; FDL
"The Coulomb wave function divided by the argument
F_L(\eta, x)/x for L = Lmin ... Lmin + kmax, storing the
......
;; Gamma functions
;; Liam Healy, Thu Apr 27 2006 - 22:06
;; Time-stamp: <2010-12-04 11:39:55EST gamma.lisp>
;; Time-stamp: <2011-10-23 22:04:31EDT gamma.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -54,7 +54,7 @@
((x :double) (ret sf-result) (sign (:pointer :double)))
:return ((multiple-value-bind (val err)
(fsbv:object ret 'sf-result)
(values val (fsbv:object sign :double) err )))
(values val (cffi:mem-ref sign :double) err )))
:documentation ; FDL
"Compute the sign of the gamma function and the logarithm of
its magnitude, subject to x not being a negative integer. The
......@@ -155,7 +155,7 @@
Gamma(a + x)/Gamma(a), subject to a, a+x not being negative integers."
:return ((multiple-value-bind (val err)
(fsbv:object ret 'sf-result)
(values val (fsbv:object sign :double) err ))))
(values val (cffi:mem-ref sign :double) err ))))
(defmfun relative-pochammer (a x)
"gsl_sf_pochrel_e" ((a :double) (x :double) (ret sf-result))
......
;; Structures returned by special functions.
;; Liam Healy, Mon Jan 1 2007 - 11:35
;; Time-stamp: <2010-12-19 16:09:12EST return-structures.lisp>
;; Time-stamp: <2011-10-23 21:15:46EDT return-structures.lisp>
;;
;; Copyright 2007, 2008, 2009, 2010 Liam M. Healy
;; Copyright 2007, 2008, 2009, 2010, 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
......@@ -24,38 +24,14 @@
;;;; Result from special functions
;;;;****************************************************************************
#|
;;; Remove #'val, #'err, #'e10 in favor of using #'fsbv:object to
;;; convert from foreign to CL.
(defun val (sf-result &optional (type 'sf-result))
(cffi:foreign-slot-value sf-result type 'val))
(defun err (sf-result &optional (type 'sf-result))
(cffi:foreign-slot-value sf-result type 'err))
(defun e10 (sf-result)
(cffi:foreign-slot-value sf-result 'sf-result-e10 'e10))
|#
;;; Define instead with fsbv:defconvert. Eventually this should get
;;; into CFFI and automatically from cffi:defcstruct; and also picked
;;; up by cffi-grovel. For the time being, FSBV is required.
#+fsbv
(fsbv:defconvert (sf-result :constructor values)
(val :double)
(err :double))
(defun values-e10 (val err e10)
(values val e10 err))
#+fsbv
(fsbv:defconvert (sf-result-e10 :constructor values-e10)
(val :double)
(err :double)
(e10 :int))
;;; Define methods for cffi:translate-from-foreign for translate-from-foreign
;;; that return the slots as successive values.
;;; (defmethod cffi:translate-from-foreign (value (type ))); sf-result
;;; (defmethod cffi:translate-from-foreign (value (type ))); sf-result-e10
;;; This should become the cffi:translate-from-foreign method for sf-result-e10
;;;(defun values-e10 (val err e10)
;;; (values val e10 err))
;;; Note: need to enhance CFFI to either make a default class name for each type, or allow the specification of a class when groveling.
(defun complex-with-error (real-sfr imaginary-sfr)
"Return two complex numbers, the value and the error."
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment