Commit 127d3d02 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Substitute for dim0 and dim1 in funcallables when scalarsp=NIL

Previously, the funcallable form made by #'make-funcallable-form (for
e.g. ODE solvers) when scalarsp=T involved substituting the symbols
'dim0 and 'dim1, but when scalarsp=NIL, would not do the substitution.
This caused an error when those unevaluated and unbound symbols
appeared in the lambda.  By altering #'faify-form with an additional
'dimension-values argument and calling 
(value-from-dimensions argspec dimension-values) 
instead of 
(parse-callback-argspec argspec 'dimensions), 
this problem is fixed.
parent 2ea64e90
Loading
Loading
Loading
Loading
+46 −44
Original line number Diff line number Diff line
;; Generate a lambda that calls the user function; will be called by callback.
;; Liam Healy 
;; Time-stamp: <2011-10-23 22:10:08EDT funcallable.lisp>
;; Time-stamp: <2012-11-18 11:16:47EST funcallable.lisp>
;;
;; Copyright 2009, 2010, 2011 Liam M. Healy
;; Copyright 2009, 2010, 2011, 2012 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,8 +25,7 @@
;;;;****************************************************************************

(defun value-from-dimensions (argspec dimension-values &optional total)
  "Return a list of numerical sizes for dimensions of an array.  If
   total = T, then return the product of those dimensions."
  "Return argspec 'dimensions with numerical sizes for dimensions substituted for dim0, dim1.  If total = T, then return the product of those dimensions.  The list dimensions-values is a list of one or two numerical values, (dim0-value dim1-value) or (dim0-value)."
  ;; (DIM0) -> numerical value
  ;; (DIM0 DIM0) -> product of numerical values
  (let ((list
@@ -36,7 +35,8 @@
		       'dim1
		       (parse-callback-argspec argspec 'dimensions)))))
    (if total
	(apply '* list) list)))
	(apply '* list)
	list)))

(defun all-io (direction &optional (arrays t))
  "Create a function that returns dimensions for argspecs that are arrays
@@ -61,7 +61,7 @@
       arg))
   argspecs))

(defun faify-form (ptr argspec)
(defun faify-form (ptr argspec dimension-values)
  "Make the form that turns the mpointer into a foreign-array."
  ;; No finalizer, because pointer might be reused by GSL.
  (ecase (parse-callback-argspec argspec 'array-type)
@@ -69,12 +69,12 @@
     `(make-foreign-array-from-mpointer
       ,ptr
       ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type))
       ,(length (parse-callback-argspec argspec 'dimensions))
       ,(length (value-from-dimensions argspec dimension-values))
       nil))				; no finalizer
    (:cvector				; a raw C vector
     `(grid:make-foreign-array-from-pointer
       ,ptr
       ',(parse-callback-argspec argspec 'dimensions)
       ',(value-from-dimensions argspec dimension-values)
       ',(grid:cffi-cl (parse-callback-argspec argspec 'element-type))
       nil))
    ((nil) ptr)))
@@ -187,12 +187,14 @@
		  (callback-set-mvb outargs-names call-form fnspec dimension-values)
		  ;; no specified output, return what the function returns
		  call-form))
	    (let ((faify-form-dv
		    (alexandria:rcurry 'faify-form dimension-values)))
	      `(funcall ,function-designator
			,@(if outarrayp
			    (append (mapcar 'faify-form inargs-names inargs-specs)
				    (mapcar 'faify-form outargs-names outarrayp))
			      (append (mapcar faify-form-dv inargs-names inargs-specs)
				      (mapcar faify-form-dv outargs-names outarrayp))
			      ;; no arrays to return, just return the value
			    (mapcar 'faify-form inargs-names inargs-specs))))
			      (mapcar faify-form-dv inargs-names inargs-specs)))))
       ,@(case
	     (parse-callback-fnspec fnspec 'return-spec)
	   (:success-failure
+4 −2
Original line number Diff line number Diff line
;; Evolution functions for ODE integration.
;; Liam Healy, Sun Sep 30 2007 - 14:31
;; Time-stamp: <2012-01-13 12:01:23EST evolution.lisp>
;; Time-stamp: <2012-11-17 12:06:56EST evolution.lisp>
;;
;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Copyright 2007, 2008, 2009, 2011, 2012 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
@@ -18,6 +18,8 @@
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; /usr/include/gsl_odeiv.h

(in-package :gsl)

(defmobject ode-evolution "gsl_odeiv_evolve"