Commit 127d3d02 authored by Liam Healy's avatar Liam Healy

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
;; 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
......
;; 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"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment