Menu
▾
▴
[Matlisp-commit] [matlisp-git]matlisp branch tensor updated. 2012-02-23-188-g4862a33
|
From: Akshay S. <ak...@us...> - 2013-01-20 07:41:49
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "matlisp".
The branch, tensor has been updated
via 4862a338530bb1b435f2d6535913abe9947931b6 (commit)
from 657120d7a8bc0b0e26bbb522697e75c9f5b92ec1 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 4862a338530bb1b435f2d6535913abe9947931b6
Author: Akshay Srinivasan <aks...@gm...>
Date: Sat Jan 19 23:36:28 2013 -0800
o Wrapped some functions inside (eval-when ..).
diff --git a/src/ffi/f77-ffi.lisp b/src/ffi/f77-ffi.lisp
index 177f431..301520e 100644
--- a/src/ffi/f77-ffi.lisp
+++ b/src/ffi/f77-ffi.lisp
@@ -10,322 +10,118 @@
(in-package #:matlisp-ffi)
-
-(definline %f77.string-p (type)
- "
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (definline %f77.string-p (type)
+ "
Checks if the given type is a string."
- (eq type :string))
+ (eq type :string))
-(definline %f77.array-p (type)
- "
+ (definline %f77.array-p (type)
+ "
Checks if the given type is an array."
- (and (listp type) (eq (car type) '*)))
+ (and (listp type) (eq (car type) '*)))
-(definline %f77.cast-as-array-p (type)
- "
+ (definline %f77.cast-as-array-p (type)
+ "
Checks if the given type is - or has to be passed as - an array."
- (or (when (listp type)
- (eq (car type) '*))
- (eq type :complex-single-float)
- (eq type :complex-double-float)))
-
-;; Check if the given type is a callback.
-(definline %f77.callback-type-p (type)
- "
+ (or (when (listp type)
+ (eq (car type) '*))
+ (eq type :complex-single-float)
+ (eq type :complex-double-float)))
+
+ ;; Check if the given type is a callback.
+ (definline %f77.callback-type-p (type)
+ "
Checks if the given type is a callback"
- (and (listp type) (eq (first type) :callback)))
-
-;; Get the equivalent CFFI type.
-;; If the type is an array, get the type of the array element type.
-(defun %f77.cffi-type (type)
- "Convert the given matlisp-ffi type into one understood by CFFI."
- (cond
- ((and (listp type) (eq (first type) '*))
- `(:pointer ,(%f77.cffi-type (second type))))
- ((%f77.callback-type-p type)
- `(:pointer ,(%f77.cffi-type :callback)))
- ((eq type :complex-single-float)
- `(:pointer ,(%f77.cffi-type :single-float)))
- ((eq type :complex-double-float)
- `(:pointer ,(%f77.cffi-type :double-float)))
- (t (ecase type
- (:void :void)
- (:integer :int32)
- (:character :char)
- (:long :int64)
- (:single-float :float)
- (:double-float :double)
- (:string :string)
- ;; Pass a pointer to the function.
- (:callback :void)
- (t (error 'unknown-token :token type
- :message "Don't know the given Fortran type."))))))
-
-(defun %f77.get-return-type (type)
- "
+ (and (listp type) (eq (first type) :callback)))
+
+ ;; Get the equivalent CFFI type.
+ ;; If the type is an array, get the type of the array element type.
+ (defun %f77.cffi-type (type)
+ "Convert the given matlisp-ffi type into one understood by CFFI."
+ (cond
+ ((and (listp type) (eq (first type) '*))
+ `(:pointer ,(%f77.cffi-type (second type))))
+ ((%f77.callback-type-p type)
+ `(:pointer ,(%f77.cffi-type :callback)))
+ ((eq type :complex-single-float)
+ `(:pointer ,(%f77.cffi-type :single-float)))
+ ((eq type :complex-double-float)
+ `(:pointer ,(%f77.cffi-type :double-float)))
+ (t (ecase type
+ (:void :void)
+ (:integer :int32)
+ (:character :char)
+ (:long :int64)
+ (:single-float :float)
+ (:double-float :double)
+ (:string :string)
+ ;; Pass a pointer to the function.
+ (:callback :void)
+ (t (error 'unknown-token :token type
+ :message "Don't know the given Fortran type."))))))
+
+ (defun %f77.get-return-type (type)
+ "
Return type understood by CFFI. Note that unlike arguments fortran
functions return-by-value."
- (if (or (%f77.cast-as-array-p type) (%f77.callback-type-p type))
- (error 'invalid-type :given type :expected '(not (or (%f77.cast-as-array-p type)
- (%f77.callback-type-p type)))
- :message "A Fortran function cannot return the given type.")
- (%f77.cffi-type type)))
-
-(definline %f77.output-p (style)
- "
+ (if (or (%f77.cast-as-array-p type) (%f77.callback-type-p type))
+ (error 'invalid-type :given type :expected '(not (or (%f77.cast-as-array-p type)
+ (%f77.callback-type-p type)))
+ :message "A Fortran function cannot return the given type.")
+ (%f77.cffi-type type)))
+
+ (definline %f77.output-p (style)
+ "
Checks if style implies output."
- (member style '(:output :input-output :workspace-output)))
+ (member style '(:output :input-output :workspace-output)))
-(definline %f77.input-p (style)
- "
+ (definline %f77.input-p (style)
+ "
Checks if style implies input."
- (member style '(:input :input-value :input-reference :workspace)))
+ (member style '(:input :input-value :input-reference :workspace)))
-(defun %f77.get-read-in-type (type &optional (style :input))
- "
+ (defun %f77.get-read-in-type (type &optional (style :input))
+ "
Get the input type to be passed to CFFI."
- (assert (member style +ffi-styles+) nil 'unknown-token :token style
- :message "Don't know how to handle style.")
- (cond
- ;; Can't do much else if type is an array/complex or input is passed-by-value.
- ((or (%f77.callback-type-p type)
- (%f77.cast-as-array-p type)
- (eq style :input-value))
- (%f77.cffi-type type))
- ;; else pass-by-reference
- (t
- `(:pointer ,(%f77.cffi-type type)))))
-
-(defun %f77.parse-fortran-parameters (body)
- "
+ (assert (member style +ffi-styles+) nil 'unknown-token :token style
+ :message "Don't know how to handle style.")
+ (cond
+ ;; Can't do much else if type is an array/complex or input is passed-by-value.
+ ((or (%f77.callback-type-p type)
+ (%f77.cast-as-array-p type)
+ (eq style :input-value))
+ (%f77.cffi-type type))
+ ;; else pass-by-reference
+ (t
+ `(:pointer ,(%f77.cffi-type type)))))
+
+ (defun %f77.parse-fortran-parameters (body)
+ "
Parse fortran parameters and convert parameters to native C90 types (and
add additional function parameters)."
- (multiple-value-bind (doc pars)
- (parse-doc-&-parameters body)
- (declare (ignore doc))
-
- (let* ((aux-pars nil)
- (new-pars
- (mapcar #'(lambda (decl)
- (destructuring-bind (name type &optional (style :input-reference)) decl
- (case type
- (:string
- ;; String lengths are appended to the function arguments,
- ;; passed by value.
- (nconsc aux-pars `((,(scat "LEN-" name) ,(%f77.cffi-type :integer))))
- `(,name ,(%f77.cffi-type :string)))
- (t
- `(,name ,(%f77.get-read-in-type type style))))))
- pars)))
- `( ;; don't want documentation for direct interface, not useful
- ;; ,@doc
- ,@new-pars ,@aux-pars))))
-
-(defmacro def-fortran-routine (name-and-options return-type &rest body)
- "
- DEF-FORTRAN-ROUTINE
-
- An external Fortran routine definition form (DEF-FORTRAN-ROUTINE
- MY-FUN ...) creates two functions:
-
- 1. a raw FFI (foreign function interface),
- 2. an easier to use lisp interface to the raw interface.
-
- The documentation given here relates in the most part to the
- simplified lisp interface.
-
- Example:
- ========
- libblas.a contains the fortran subroutine DCOPY(N,X,INCX,Y,INCY)
- which copies the vector Y of N double-float's to the vector X.
- The function name in libblas.a is \"dcopy_\" (by Fortran convention).
-
- (DEF-FORTRAN-ROUTINE DCOPY :void
- (N :integer :input)
- (X (* :double-float) :output)
- (INCX :integer :input)
- (Y (* :double-float) :input)
- (INCY :integer :input))
-
- will expand into:
-
- (CFFI:DEFCFUN (\"dcopy_\" FORTRAN-DCOPY) :VOID
- (N :POINTER :INT)
- (DX :POINTER :DOUBLE)
- (INCX :POINTER :INT)
- (DY :POINTER :DOUBLE)
- (INCY :POINTER :INT))
-
- and
-
- (DEFUN DCOPY (N,X,INCX,Y,INCY)
- ...
-
- In turn, the lisp function DCOPY calls FORTRAN-DCOPY which calls
- the Fortran function \"dcopy_\" in libblas.a.
-
- Arguments:
- ==========
-
-
- NAME Name of the lisp interface function that will be created.
- The name of the raw FFI will be derived from NAME via
- the function MAKE-FFI-NAME. The name of foreign function
- (presumable a Fortran Function in an external library)
- will be derived from NAME via MAKE-FORTRAN-NAME.
-
- RETURN-TYPE
- The type of data that will be returned by the external
- (presumably Fortran) function.
-
- (MEMBER RETURN-TYPE '(:VOID :INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
- :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT))
-
- See GET-READ-OUT-TYPE.
-
- BODY A list of parameter forms. A parameter form is:
-
- (VARIABLE TYPE &optional (STYLE :INPUT))
-
- The VARIABLE is the name of a parameter accepted by the
- external (presumably Fortran) routine. TYPE is the type of
- VARIABLE. The recognized TYPE's are:
-
- TYPE Corresponds to Fortran Declaration
- ---- ----------------------------------
- :STRING CHARACTER*(*)
- :INTEGER INTEGER
- :SINGLE-FLOAT REAL
- :DOUBLE-FLOAT DOUBLE PRECISION
- :COMPLEX-SINGLE-FLOAT COMPLEX
- :COMPLEX-DOUBLE-FLOAT COMPLEX*16
- (* X) An array of type X.
- (:CALLBACK args) A description of a function or subroutine
-
- (MEMBER X '(:INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
- :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT)
-
-
- The STYLE (default :INPUT) defines how VARIABLE is treated.
- This is by far the most difficult quantity to learn. To
- begin with:
-
-
- (OR (MEMBER STYLE '(:INPUT :OUTPUT :INPUT-OUTPUT))
- (MEMBER STYLE '(:IN :COPY :IN-OUT :OUT)))
-
- TYPE STYLE Description
- ---- ----- -----------
- X :INPUT Value will be used but not modified.
-
- :OUTPUT Input value not used (but some value must be given),
- a value is returned as one of the values lisp
- function NAME. Similar to the :IN-OUT style
- of DEF-ALIEN-ROUTINE.
- :INPUT-OUTPUT Input value may be used, a value is returned
- as one of the values from the lisp function
- NAME.
-
- ** Note: In all 3 cases above the input VARIABLE will not be destroyed
- or modified directly, a copy is taken and a pointer of that
- copy is passed to the (presumably Fortran) external routine.
-
- (OR (* X) :INPUT Array entries are used but not modified.
- :STRING) :OUTPUT Array entries need not be initialized on input,
- but will be *modified*. In addition, the array
- will be returned via the Lisp command VALUES
- from the lisp function NAME.
-
- :INPUT-OUTPUT Like :OUTPUT but initial values on entry may be used.
-
- The keyword :WORKSPACE is a nickname for :INPUT. The
- keywords :INPUT-OR-OUTPUT, :WORKSPACE-OUTPUT,
- :WORKSPACE-OR-OUTPUT are nicknames for :OUTPUT.
-
- This is complicated. Suggestions are encouraged to
- interface a *functional language* to a *pass-by-reference
- language*.
-
- CALLBACKS
-
- A callback here means a function (or subroutine) that is passed into the Fortran
- routine which calls it as needed to compute something.
-
- The syntax of :CALLBACK is similar to the DEF-FORTRAN-ROUTINE:
-
- (name (:CALLBACK return-type
- {arg-description}))
-
- The RETURN-TYPE is the same as for DEF-FORTRAN-ROUTINE. The arg description is the
- same syntax as list of parameter forms for DEF-FORTRAN-ROUTINE. However, if the type
- is a pointer type (like (* :double-float)), then a required keyword option must be
- specified:
-
- (name (* type :size size) &optional style)
-
- The size specifies the total length of the Fortran array. This array is treated as a
- one dimentionsal vector and should be accessed using the function FV-REF, which is
- analogous to AREF. The SIZE parameter can be any Lisp form and can refer to any of the
- arguments to the Fortran routine.
-
- For example, a fortran routine can have the callback
-
- (def-fortran-routine foo :void
- (m (* :integer) :input)
- (fsub (:callback :void
- (x :double-float :input)
- (z (* :double-float :size (aref m 0)) :input)
- (f (* :double-float :size (aref m 0)) :output)))))
-
- This means that the arrays Z and F in FSUB have a dimension of (AREF M 0), the first
- element of the vector M. The function FSUB can be written in Lisp as
-
- (defun fsub (x z f)
- (setf (fv-ref f 0) (* x x (fv-ref z 3))))
-
- Further Notes:
- ===============
-
- Some Fortran routines use Fortran character strings in the
- parameter list. The definition here is suitable for Solaris
- where the Fortran character string is converted to a C-style null
- terminated string, AND an extra hidden parameter that is appended
- to the parameter list to hold the length of the string.
-
- If your Fortran does this differently, you'll have to change this
- definition accordingly!
-
- Call defcfun to define the foreign function.
- Also creates a nice lisp helper function."
- (multiple-value-bind (fortran-name name) (if (listp name-and-options)
- (values (car name-and-options) (cadr name-and-options))
- (values (make-fortran-name name-and-options) name-and-options))
- (let* ((lisp-name (make-fortran-ffi-name `,name))
- (hack-return-type `,return-type)
- (hack-body `(,@body))
- (hidden-var-name nil))
- ;;
- (multiple-value-bind (doc pars)
- (parse-doc-&-parameters `(,@body))
- (when (member hack-return-type '(:complex-single-float :complex-double-float))
- ;; The return type is complex. Since this is a "structure",
- ;; Fortran inserts a "hidden" first parameter before all
- ;; others. This is used to store the resulting complex
- ;; number. Then there is no "return" value, so set the return
- ;; type to :void.
- ;;
- (setq hidden-var-name (gensym "HIDDEN-COMPLEX-RETURN-"))
- (setq hack-body `(,@doc
- (,hidden-var-name ,hack-return-type :output)
- ,@pars))
- (setq hack-return-type :void)))
-
- `(progn
- (cffi:defcfun (,fortran-name ,lisp-name) ,(%f77.get-return-type hack-return-type)
- ,@(%f77.parse-fortran-parameters hack-body))
- ,@(%f77.def-fortran-interface name hack-return-type hack-body hidden-var-name)))))
-
-;; Create a form specifying a simple Lisp function that calls the
+ (multiple-value-bind (doc pars)
+ (parse-doc-&-parameters body)
+ (declare (ignore doc))
+
+ (let* ((aux-pars nil)
+ (new-pars
+ (mapcar #'(lambda (decl)
+ (destructuring-bind (name type &optional (style :input-reference)) decl
+ (case type
+ (:string
+ ;; String lengths are appended to the function arguments,
+ ;; passed by value.
+ (nconsc aux-pars `((,(scat "LEN-" name) ,(%f77.cffi-type :integer))))
+ `(,name ,(%f77.cffi-type :string)))
+ (t
+ `(,name ,(%f77.get-read-in-type type style))))))
+ pars)))
+ `( ;; don't want documentation for direct interface, not useful
+ ;; ,@doc
+ ,@new-pars ,@aux-pars))))
+
+ ;; Create a form specifying a simple Lisp function that calls the
;; underlying Fortran routine of the same name.
(defun %f77.def-fortran-interface (name return-type body hidden-var-name)
(multiple-value-bind (doc pars)
@@ -450,6 +246,9 @@
,@(mapcar #'second return-vars)))))))))
;;TODO: Outputs are messed up inside the callback
+;;TODO: Define callbacks outside the function call and lexically bind functions inside the
+;; call. Callbacks allocate memory in some non-GC'ed part of the heap. Runs out of memory
+;; quite quickly.
(defun %f77.def-fortran-callback (func callback-name return-type parm)
(let* ((hack-return-type `,return-type)
(hack-parm `(,@parm))
@@ -542,3 +341,208 @@
,(if (eq hack-return-type :void)
nil
retvar))))))))
+)
+
+(defmacro def-fortran-routine (name-and-options return-type &rest body)
+ "
+ DEF-FORTRAN-ROUTINE
+
+ An external Fortran routine definition form (DEF-FORTRAN-ROUTINE
+ MY-FUN ...) creates two functions:
+
+ 1. a raw FFI (foreign function interface),
+ 2. an easier to use lisp interface to the raw interface.
+
+ The documentation given here relates in the most part to the
+ simplified lisp interface.
+
+ Example:
+ ========
+ libblas.a contains the fortran subroutine DCOPY(N,X,INCX,Y,INCY)
+ which copies the vector Y of N double-float's to the vector X.
+ The function name in libblas.a is \"dcopy_\" (by Fortran convention).
+
+ (DEF-FORTRAN-ROUTINE DCOPY :void
+ (N :integer :input)
+ (X (* :double-float) :output)
+ (INCX :integer :input)
+ (Y (* :double-float) :input)
+ (INCY :integer :input))
+
+ will expand into:
+
+ (CFFI:DEFCFUN (\"dcopy_\" FORTRAN-DCOPY) :VOID
+ (N :POINTER :INT)
+ (DX :POINTER :DOUBLE)
+ (INCX :POINTER :INT)
+ (DY :POINTER :DOUBLE)
+ (INCY :POINTER :INT))
+
+ and
+
+ (DEFUN DCOPY (N,X,INCX,Y,INCY)
+ ...
+
+ In turn, the lisp function DCOPY calls FORTRAN-DCOPY which calls
+ the Fortran function \"dcopy_\" in libblas.a.
+
+ Arguments:
+ ==========
+
+
+ NAME Name of the lisp interface function that will be created.
+ The name of the raw FFI will be derived from NAME via
+ the function MAKE-FFI-NAME. The name of foreign function
+ (presumable a Fortran Function in an external library)
+ will be derived from NAME via MAKE-FORTRAN-NAME.
+
+ RETURN-TYPE
+ The type of data that will be returned by the external
+ (presumably Fortran) function.
+
+ (MEMBER RETURN-TYPE '(:VOID :INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
+ :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT))
+
+ See GET-READ-OUT-TYPE.
+
+ BODY A list of parameter forms. A parameter form is:
+
+ (VARIABLE TYPE &optional (STYLE :INPUT))
+
+ The VARIABLE is the name of a parameter accepted by the
+ external (presumably Fortran) routine. TYPE is the type of
+ VARIABLE. The recognized TYPE's are:
+
+ TYPE Corresponds to Fortran Declaration
+ ---- ----------------------------------
+ :STRING CHARACTER*(*)
+ :INTEGER INTEGER
+ :SINGLE-FLOAT REAL
+ :DOUBLE-FLOAT DOUBLE PRECISION
+ :COMPLEX-SINGLE-FLOAT COMPLEX
+ :COMPLEX-DOUBLE-FLOAT COMPLEX*16
+ (* X) An array of type X.
+ (:CALLBACK args) A description of a function or subroutine
+
+ (MEMBER X '(:INTEGER :SINGLE-FLOAT :DOUBLE-FLOAT
+ :COMPLEX-SINGLE-FLOAT :COMPLEX-DOUBLE-FLOAT)
+
+
+ The STYLE (default :INPUT) defines how VARIABLE is treated.
+ This is by far the most difficult quantity to learn. To
+ begin with:
+
+
+ (OR (MEMBER STYLE '(:INPUT :OUTPUT :INPUT-OUTPUT))
+ (MEMBER STYLE '(:IN :COPY :IN-OUT :OUT)))
+
+ TYPE STYLE Description
+ ---- ----- -----------
+ X :INPUT Value will be used but not modified.
+
+ :OUTPUT Input value not used (but some value must be given),
+ a value is returned as one of the values lisp
+ function NAME. Similar to the :IN-OUT style
+ of DEF-ALIEN-ROUTINE.
+ :INPUT-OUTPUT Input value may be used, a value is returned
+ as one of the values from the lisp function
+ NAME.
+
+ ** Note: In all 3 cases above the input VARIABLE will not be destroyed
+ or modified directly, a copy is taken and a pointer of that
+ copy is passed to the (presumably Fortran) external routine.
+
+ (OR (* X) :INPUT Array entries are used but not modified.
+ :STRING) :OUTPUT Array entries need not be initialized on input,
+ but will be *modified*. In addition, the array
+ will be returned via the Lisp command VALUES
+ from the lisp function NAME.
+
+ :INPUT-OUTPUT Like :OUTPUT but initial values on entry may be used.
+
+ The keyword :WORKSPACE is a nickname for :INPUT. The
+ keywords :INPUT-OR-OUTPUT, :WORKSPACE-OUTPUT,
+ :WORKSPACE-OR-OUTPUT are nicknames for :OUTPUT.
+
+ This is complicated. Suggestions are encouraged to
+ interface a *functional language* to a *pass-by-reference
+ language*.
+
+ CALLBACKS
+
+ A callback here means a function (or subroutine) that is passed into the Fortran
+ routine which calls it as needed to compute something.
+
+ The syntax of :CALLBACK is similar to the DEF-FORTRAN-ROUTINE:
+
+ (name (:CALLBACK return-type
+ {arg-description}))
+
+ The RETURN-TYPE is the same as for DEF-FORTRAN-ROUTINE. The arg description is the
+ same syntax as list of parameter forms for DEF-FORTRAN-ROUTINE. However, if the type
+ is a pointer type (like (* :double-float)), then a required keyword option must be
+ specified:
+
+ (name (* type :size size) &optional style)
+
+ The size specifies the total length of the Fortran array. This array is treated as a
+ one dimentionsal vector and should be accessed using the function FV-REF, which is
+ analogous to AREF. The SIZE parameter can be any Lisp form and can refer to any of the
+ arguments to the Fortran routine.
+
+ For example, a fortran routine can have the callback
+
+ (def-fortran-routine foo :void
+ (m (* :integer) :input)
+ (fsub (:callback :void
+ (x :double-float :input)
+ (z (* :double-float :size (aref m 0)) :input)
+ (f (* :double-float :size (aref m 0)) :output)))))
+
+ This means that the arrays Z and F in FSUB have a dimension of (AREF M 0), the first
+ element of the vector M. The function FSUB can be written in Lisp as
+
+ (defun fsub (x z f)
+ (setf (fv-ref f 0) (* x x (fv-ref z 3))))
+
+ Further Notes:
+ ===============
+
+ Some Fortran routines use Fortran character strings in the
+ parameter list. The definition here is suitable for Solaris
+ where the Fortran character string is converted to a C-style null
+ terminated string, AND an extra hidden parameter that is appended
+ to the parameter list to hold the length of the string.
+
+ If your Fortran does this differently, you'll have to change this
+ definition accordingly!
+
+ Call defcfun to define the foreign function.
+ Also creates a nice lisp helper function."
+ (multiple-value-bind (fortran-name name) (if (listp name-and-options)
+ (values (car name-and-options) (cadr name-and-options))
+ (values (make-fortran-name name-and-options) name-and-options))
+ (let* ((lisp-name (make-fortran-ffi-name `,name))
+ (hack-return-type `,return-type)
+ (hack-body `(,@body))
+ (hidden-var-name nil))
+ ;;
+ (multiple-value-bind (doc pars)
+ (parse-doc-&-parameters `(,@body))
+ (when (member hack-return-type '(:complex-single-float :complex-double-float))
+ ;; The return type is complex. Since this is a "structure",
+ ;; Fortran inserts a "hidden" first parameter before all
+ ;; others. This is used to store the resulting complex
+ ;; number. Then there is no "return" value, so set the return
+ ;; type to :void.
+ ;;
+ (setq hidden-var-name (gensym "HIDDEN-COMPLEX-RETURN-"))
+ (setq hack-body `(,@doc
+ (,hidden-var-name ,hack-return-type :output)
+ ,@pars))
+ (setq hack-return-type :void)))
+
+ `(progn
+ (cffi:defcfun (,fortran-name ,lisp-name) ,(%f77.get-return-type hack-return-type)
+ ,@(%f77.parse-fortran-parameters hack-body))
+ ,@(%f77.def-fortran-interface name hack-return-type hack-body hidden-var-name)))))
diff --git a/src/ffi/f77-mangling.lisp.in b/src/ffi/f77-mangling.lisp.in
index df051f0..a7cf0da 100644
--- a/src/ffi/f77-mangling.lisp.in
+++ b/src/ffi/f77-mangling.lisp.in
@@ -3,42 +3,42 @@
(in-package #:matlisp-ffi)
(eval-when (:compile-toplevel :load-toplevel :execute)
-(defconstant +f77-lower-case+ @F77_LOWER_CASE@
- "Fortran names are lower case if non-NIL")
-(defconstant +f77-underscore+ @F77_UNDERSCORE@
- "Fortran names have a trailing underscore if non-NIL")
-(defconstant +f77-extra-underscore+ @F77_EXTRA_UNDERSCORE@
- "Fortran names containing an underscore have an extra underscore appended if non-NIL")
-)
+ (defconstant +f77-lower-case+ @F77_LOWER_CASE@
+ "Fortran names are lower case if non-NIL")
+ (defconstant +f77-underscore+ @F77_UNDERSCORE@
+ "Fortran names have a trailing underscore if non-NIL")
+ (defconstant +f77-extra-underscore+ @F77_EXTRA_UNDERSCORE@
+ "Fortran names containing an underscore have an extra underscore appended if non-NIL")
-(defun %cat% (prefix-string s &optional suffix-string)
- (concatenate 'string
- prefix-string
- (string s)
- suffix-string))
+ (defun %cat% (prefix-string s &optional suffix-string)
+ (concatenate 'string
+ prefix-string
+ (string s)
+ suffix-string))
-(defun scat (prefix-string s &optional suffix-string)
- (intern (%cat% prefix-string s suffix-string)))
+ (defun scat (prefix-string s &optional suffix-string)
+ (intern (%cat% prefix-string s suffix-string)))
-;; If the Fortran function name is NAME, the Lisp FFI name prepends
-;; "FORTRAN-"
-(defun make-fortran-ffi-name (name)
- (scat "FORTRAN-" name))
+ ;; If the Fortran function name is NAME, the Lisp FFI name prepends
+ ;; "FORTRAN-"
+ (defun make-fortran-ffi-name (name)
+ (scat "FORTRAN-" name))
-(defun make-fortran-name (name)
- ;; Given the Fortran routine name NAME, this returns the real
- ;; underlying name. This depends on the compiler conventions being
- ;; used. Some Fortran compilers take the Fortran name NAME and
- ;; produce "name_" as the real routine name. Others will prepend
- ;; the underscore. Yet others might convert the name to all upper
- ;; case.
- (let* ((internal-underscore-p (position #\_ (symbol-name name)))
- (name (concatenate 'string
- (symbol-name name)
- (if +f77-underscore+ "_" "")
- (if (and +f77-extra-underscore+ internal-underscore-p)
- "_" ""))))
- (declare (ignorable internal-underscore-p))
- (if +f77-lower-case+
- (string-downcase name)
- name)))
+ (defun make-fortran-name (name)
+ ;; Given the Fortran routine name NAME, this returns the real
+ ;; underlying name. This depends on the compiler conventions being
+ ;; used. Some Fortran compilers take the Fortran name NAME and
+ ;; produce "name_" as the real routine name. Others will prepend
+ ;; the underscore. Yet others might convert the name to all upper
+ ;; case.
+ (let* ((internal-underscore-p (position #\_ (symbol-name name)))
+ (name (concatenate 'string
+ (symbol-name name)
+ (if +f77-underscore+ "_" "")
+ (if (and +f77-extra-underscore+ internal-underscore-p)
+ "_" ""))))
+ (declare (ignorable internal-underscore-p))
+ (if +f77-lower-case+
+ (string-downcase name)
+ name)))
+)
diff --git a/src/ffi/ffi-cffi.lisp b/src/ffi/ffi-cffi.lisp
index 8429984..5698605 100644
--- a/src/ffi/ffi-cffi.lisp
+++ b/src/ffi/ffi-cffi.lisp
@@ -10,30 +10,31 @@
(in-package #:matlisp-ffi)
-(define-constant +ffi-styles+
- '(:input :input-reference :input-value
- :input-output :output :workspace-output
- :workspace))
-
-(define-constant +ffi-types+
- '(:single-float :double-float
- :complex-single-float :complex-double-float
- :integer :long
- :string :character
- :callback))
-
-(define-constant +ffi-array-types+
- '(:single-float :double-float
- :integer :long))
-
-;; Separte the body of code into documentation and parameter lists.
-(defun parse-doc-&-parameters (body &optional header footer)
- (if (stringp (first body))
- (values `(,(%cat% header (first body) footer)) (rest body))
- (values (if (or header footer)
- (%cat% header "" footer)
- nil)
- body)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (define-constant +ffi-styles+
+ '(:input :input-reference :input-value
+ :input-output :output :workspace-output
+ :workspace))
+
+ (define-constant +ffi-types+
+ '(:single-float :double-float
+ :complex-single-float :complex-double-float
+ :integer :long
+ :string :character
+ :callback))
+
+ (define-constant +ffi-array-types+
+ '(:single-float :double-float
+ :integer :long))
+
+ ;; Separte the body of code into documentation and parameter lists.
+ (defun parse-doc-&-parameters (body &optional header footer)
+ (if (stringp (first body))
+ (values `(,(%cat% header (first body) footer)) (rest body))
+ (values (if (or header footer)
+ (%cat% header "" footer)
+ nil)
+ body))))
;; Create objects on the heap and run some stuff.
(defmacro with-foreign-objects-heaped (declarations &rest body)
@@ -122,8 +123,8 @@
,@body))))
;; Increment the pointer.
-(defun inc-sap (sap type &optional (n 1))
-"
+(definline inc-sap (sap type &optional (n 1))
+ "
Increment the pointer address by one \"slot\"
depending on the type:
:double-float 8 bytes
@@ -131,12 +132,12 @@
:complex-double-float 8x2 bytes
:complex-single-float 4x2 bytes
"
- (cffi:inc-pointer sap
- (ecase type
- (:double-float (* n 8))
- (:single-float (* n 4))
- (:complex-double-float (* n 16))
- (:complex-single-float (* n 8)))))
+ (cffi:inc-pointer sap
+ (ecase type
+ (:double-float (* n 8))
+ (:single-float (* n 4))
+ (:complex-double-float (* n 16))
+ (:complex-single-float (* n 8)))))
(define-modify-macro incf-sap (type &optional (n 1)) inc-sap)
diff --git a/src/utilities/functions.lisp b/src/utilities/functions.lisp
index c0570e8..079c6ba 100644
--- a/src/utilities/functions.lisp
+++ b/src/utilities/functions.lisp
@@ -1,8 +1,11 @@
(in-package #:matlisp-utilities)
-(declaim (inline slot-values))
-(defun slot-values (obj slots)
- "
+;;These functions are used all over the place inside Matlisp's macros.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+ (declaim (inline slot-values))
+ (defun slot-values (obj slots)
+ "
Returns the slots of the @arg{obj} corresponding to symbols in the list @arg{slots}.
Example:
@@ -15,13 +18,13 @@
=> 1 2
@end lisp
"
- (values-list
- (loop :for slt :in slots
- :collect (slot-value obj slt))))
+ (values-list
+ (loop :for slt :in slots
+ :collect (slot-value obj slt))))
-(declaim (inline linear-array-type))
-(defun linear-array-type (type-sym &optional (size '*))
- "
+ (declaim (inline linear-array-type))
+ (defun linear-array-type (type-sym &optional (size '*))
+ "
Creates the list representing simple-array with type @arg{type-sym}.
Example:
@@ -30,11 +33,11 @@
=> (simple-array double-float (10))
@end lisp
"
- `(simple-array ,type-sym (,size)))
+ `(simple-array ,type-sym (,size)))
-(declaim (inline ensure-list))
-(defun ensure-list (lst)
- "
+ (declaim (inline ensure-list))
+ (defun ensure-list (lst)
+ "
Ensconses @arg{lst} inside a list if it is an atom.
Example:
@@ -43,10 +46,10 @@
=> (a)
@end lisp
"
- (if (listp lst) lst `(,lst)))
+ (if (listp lst) lst `(,lst)))
-(defun cut-cons-chain! (lst test)
- "
+ (defun cut-cons-chain! (lst test)
+ "
Destructively cuts @arg{lst} into two parts, at the element where the function
@arg{test} returns a non-nil value.
@@ -57,20 +60,20 @@
=> (3 5) (3 5) (2 1 7 9)
@end lisp
"
- (declare (type list lst))
- (labels ((cut-cons-chain-tin (lst test parent-lst)
- (cond
- ((null lst) nil)
- ((funcall test (cadr lst))
- (let ((keys (cdr lst)))
- (setf (cdr lst) nil)
- (values parent-lst keys)))
- (t (cut-cons-chain-tin (cdr lst) test parent-lst)))))
- (cut-cons-chain-tin lst test lst)))
-
-(declaim (inline zip))
-(defun zip (&rest args)
- "
+ (declare (type list lst))
+ (labels ((cut-cons-chain-tin (lst test parent-lst)
+ (cond
+ ((null lst) nil)
+ ((funcall test (cadr lst))
+ (let ((keys (cdr lst)))
+ (setf (cdr lst) nil)
+ (values parent-lst keys)))
+ (t (cut-cons-chain-tin (cdr lst) test parent-lst)))))
+ (cut-cons-chain-tin lst test lst)))
+
+ (declaim (inline zip))
+ (defun zip (&rest args)
+ "
Zips the elements of @arg{args}.
Example:
@@ -79,10 +82,10 @@
=> ((2 A J) (3 B H) (4 C C))
@end lisp
"
- (apply #'map 'list #'list args))
+ (apply #'map 'list #'list args))
-(defun recursive-append (&rest lsts)
- "
+ (defun recursive-append (&rest lsts)
+ "
Appends lists in a nested manner, mostly used to bring in the charm of
non-lispy languages into macros.
@@ -129,15 +132,15 @@
X)
@end lisp
"
- (labels ((bin-append (x y)
- (if (null x)
- (if (typep (car y) 'symbol) y (car y))
- (append x (if (null y) nil
- (if (typep (car y) 'symbol) `(,y) y))))))
- (reduce #'bin-append lsts :from-end t)))
-
-(defun unquote-args (lst args)
- "
+ (labels ((bin-append (x y)
+ (if (null x)
+ (if (typep (car y) 'symbol) y (car y))
+ (append x (if (null y) nil
+ (if (typep (car y) 'symbol) `(,y) y))))))
+ (reduce #'bin-append lsts :from-end t)))
+
+ (defun unquote-args (lst args)
+ "
Makes a list suitable for use inside macros (sort-of), by building a
new list quoting every symbol in @arg{lst} other than those in @arg{args}.
CAUTION: DO NOT use backquotes!
@@ -151,34 +154,34 @@
=> (LIST 'LET (LIST (LIST X '1)) (LIST '+ X '1))
@end lisp
"
- (labels ((replace-atoms (lst ret)
- (cond
- ((null lst) (reverse ret))
- ((atom lst)
- (let ((ret (reverse ret)))
- (rplacd (last ret) lst)
- ret))
- ((consp lst)
- (replace-atoms (cdr lst) (let ((fst (car lst)))
- (cond
- ((atom fst)
- (if (member fst args)
- (cons fst ret)
- (append `(',fst) ret)))
- ((consp fst)
- (cons (replace-lst fst nil) ret))))))))
- (replace-lst (lst acc)
- (cond
- ((null lst) acc)
- ((consp lst)
- (if (eq (car lst) 'quote)
- lst
- (cons 'list (replace-atoms lst nil))))
- ((atom lst) lst))))
- (replace-lst lst nil)))
-
-(defun flatten (x)
- "
+ (labels ((replace-atoms (lst ret)
+ (cond
+ ((null lst) (reverse ret))
+ ((atom lst)
+ (let ((ret (reverse ret)))
+ (rplacd (last ret) lst)
+ ret))
+ ((consp lst)
+ (replace-atoms (cdr lst) (let ((fst (car lst)))
+ (cond
+ ((atom fst)
+ (if (member fst args)
+ (cons fst ret)
+ (append `(',fst) ret)))
+ ((consp fst)
+ (cons (replace-lst fst nil) ret))))))))
+ (replace-lst (lst acc)
+ (cond
+ ((null lst) acc)
+ ((consp lst)
+ (if (eq (car lst) 'quote)
+ lst
+ (cons 'list (replace-atoms lst nil))))
+ ((atom lst) lst))))
+ (replace-lst lst nil)))
+
+ (defun flatten (x)
+ "
Returns a new list by collecting all the symbols found in @arg{x}.
Borrowed from Onlisp.
@@ -188,16 +191,16 @@
=> (LET X 1 + X 2)
@end lisp
"
- (labels ((rec (x acc)
- (cond ((null x) acc)
- ((atom x) (cons x acc))
- (t (rec
- (car x)
- (rec (cdr x) acc))))))
- (rec x nil)))
-
-(defun list-dimensions (lst)
- "
+ (labels ((rec (x acc)
+ (cond ((null x) acc)
+ ((atom x) (cons x acc))
+ (t (rec
+ (car x)
+ (rec (cdr x) acc))))))
+ (rec x nil)))
+
+ (defun list-dimensions (lst)
+ "
Returns the dimensions of the nested list @arg{lst}, by finding the length
of the immediate list, recursively. This does not ensure the uniformity of
lengths of the lists.
@@ -208,19 +211,21 @@
=> (2 3)
@end lisp
"
- (declare (type list lst))
- (labels ((lst-tread (idx lst)
- (if (null lst) (reverse idx)
- (progn
- (setf (car idx) (length lst))
- (if (consp (car lst))
- (lst-tread (cons 0 idx) (car lst))
- (reverse idx))))))
- (lst-tread (list 0) lst)))
-
-(defun compile-and-eval (source)
- "
+ (declare (type list lst))
+ (labels ((lst-tread (idx lst)
+ (if (null lst) (reverse idx)
+ (progn
+ (setf (car idx) (length lst))
+ (if (consp (car lst))
+ (lst-tread (cons 0 idx) (car lst))
+ (reverse idx))))))
+ (lst-tread (list 0) lst)))
+
+ (defun compile-and-eval (source)
+ "
Compiles and evaluates the given @arg{source}. This should be
an ANSI compatible way of ensuring method compilation."
- (funcall (compile nil `(lambda () ,source))))
+ (funcall (compile nil `(lambda () ,source))))
+
+ )
diff --git a/src/utilities/lvec.lisp b/src/utilities/lvec.lisp
index 2891b36..3ab1918 100644
--- a/src/utilities/lvec.lisp
+++ b/src/utilities/lvec.lisp
@@ -1,79 +1,81 @@
(in-package #:matlisp-utilities)
-(definline lvec-foldl (func vec)
- (declare (type vector))
- (loop
- :for i :of-type fixnum :from 0 :below (length vec)
- :for ret = (aref vec 0) :then (funcall func (aref vec i) ret)
- :finally (return ret)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (definline lvec-foldl (func vec)
+ (declare (type vector))
+ (loop
+ :for i :of-type fixnum :from 0 :below (length vec)
+ :for ret = (aref vec 0) :then (funcall func (aref vec i) ret)
+ :finally (return ret)))
-(definline lvec-foldr (func vec)
- (declare (type vector))
- (loop
- :for i :of-type fixnum :downfrom (1- (length vec)) :to 0
- :for ret = (aref vec (1- (length vec))) :then (funcall func (aref vec i) ret)
- :finally (return ret)))
+ (definline lvec-foldr (func vec)
+ (declare (type vector))
+ (loop
+ :for i :of-type fixnum :downfrom (1- (length vec)) :to 0
+ :for ret = (aref vec (1- (length vec))) :then (funcall func (aref vec i) ret)
+ :finally (return ret)))
-(definline lvec-map-foldl! (func vec)
- (declare (type vector))
- (loop
- :for i :of-type fixnum :from 0 :below (length vec)
- :for ret = (aref vec 0) :then (funcall func (aref vec i) ret)
- :do (setf (aref vec i) ret)
- :finally (return (values ret vec))))
+ (definline lvec-map-foldl! (func vec)
+ (declare (type vector))
+ (loop
+ :for i :of-type fixnum :from 0 :below (length vec)
+ :for ret = (aref vec 0) :then (funcall func (aref vec i) ret)
+ :do (setf (aref vec i) ret)
+ :finally (return (values ret vec))))
-(definline lvec-map-foldr! (func vec)
- (declare (type vector))
- (loop
- :for i :of-type fixnum :downfrom (1- (length vec)) :to 0
- :for ret = (aref vec (1- (length vec))) :then (funcall func (aref vec i) ret)
- :do (setf (aref vec i) ret)
- :finally (return (values ret vec))))
+ (definline lvec-map-foldr! (func vec)
+ (declare (type vector))
+ (loop
+ :for i :of-type fixnum :downfrom (1- (length vec)) :to 0
+ :for ret = (aref vec (1- (length vec))) :then (funcall func (aref vec i) ret)
+ :do (setf (aref vec i) ret)
+ :finally (return (values ret vec))))
-(definline lvec-max (vec)
- (declare (type vector vec))
- (loop :for ele :across vec
- :for idx :of-type fixnum = 0 :then (+ idx 1)
- :with max :of-type fixnum = (aref vec 0)
- :with max-idx :of-type fixnum = 0
- :do (when (> ele max)
- (setf max ele
- max-idx idx))
- :finally (return (values max max-idx))))
+ (definline lvec-max (vec)
+ (declare (type vector vec))
+ (loop :for ele :across vec
+ :for idx :of-type fixnum = 0 :then (+ idx 1)
+ :with max :of-type fixnum = (aref vec 0)
+ :with max-idx :of-type fixnum = 0
+ :do (when (> ele max)
+ (setf max ele
+ max-idx idx))
+ :finally (return (values max max-idx))))
-(definline lvec-min (vec)
- (declare (type vector vec))
- (loop :for ele :across vec
- :for idx :of-type fixnum = 0 :then (+ idx 1)
- :with min :of-type fixnum = (aref vec 0)
- :with min-idx :of-type fixnum = 0
- :do (when (< ele min)
- (setf min ele
- min-idx idx))
- :finally (return (values min min-idx))))
+ (definline lvec-min (vec)
+ (declare (type vector vec))
+ (loop :for ele :across vec
+ :for idx :of-type fixnum = 0 :then (+ idx 1)
+ :with min :of-type fixnum = (aref vec 0)
+ :with min-idx :of-type fixnum = 0
+ :do (when (< ele min)
+ (setf min ele
+ min-idx idx))
+ :finally (return (values min min-idx))))
-(definline lvec-eq (va vb &optional (test #'eq))
- (declare (type vector va vb))
- (let ((la (length va))
- (lb (length vb)))
- (if (/= la lb) nil
- (loop
- :for ele-a :across va
- :for ele-b :across vb
- :unless (funcall test ele-a ele-b)
- :do (return nil)
- :finally (return t)))))
+ (definline lvec-eq (va vb &optional (test #'eq))
+ (declare (type vector va vb))
+ (let ((la (length va))
+ (lb (length vb)))
+ (if (/= la lb) nil
+ (loop
+ :for ele-a :across va
+ :for ele-b :across vb
+ :unless (funcall test ele-a ele-b)
+ :do (return nil)
+ :finally (return t)))))
-(definline lvec->list (va)
- (declare (type vector va))
- (loop :for ele :across va
- :collect ele))
+ (definline lvec->list (va)
+ (declare (type vector va))
+ (loop :for ele :across va
+ :collect ele))
-(definline lvec->list! (va la)
- (declare (type vector va)
- (type list la))
- (loop
- :for ele :across va
- :for lst = la :then (cdr lst)
- :do (setf (car lst) ele))
- la)
+ (definline lvec->list! (va la)
+ (declare (type vector va)
+ (type list la))
+ (loop
+ :for ele :across va
+ :for lst = la :then (cdr lst)
+ :do (setf (car lst) ele))
+ la)
+)
diff --git a/src/utilities/string.lisp b/src/utilities/string.lisp
index c15fd01..1833467 100644
--- a/src/utilities/string.lisp
+++ b/src/utilities/string.lisp
@@ -1,8 +1,10 @@
(in-package #:matlisp-utilities)
-(declaim (inline string+))
-(defun string+ (&rest strings)
- (apply #'concatenate (cons 'string strings)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (declaim (inline string+))
+ (defun string+ (&rest strings)
+ (apply #'concatenate (cons 'string strings)))
-(defun format-to-string (fmt &rest args)
- (apply #'format (append (list nil fmt) args)))
+ (defun format-to-string (fmt &rest args)
+ (apply #'format (append (list nil fmt) args)))
+)
-----------------------------------------------------------------------
Summary of changes:
src/ffi/f77-ffi.lisp | 606 +++++++++++++++++++++---------------------
src/ffi/f77-mangling.lisp.in | 70 +++---
src/ffi/ffi-cffi.lisp | 65 +++---
src/utilities/functions.lisp | 191 +++++++-------
src/utilities/lvec.lisp | 140 +++++-----
src/utilities/string.lisp | 12 +-
6 files changed, 549 insertions(+), 535 deletions(-)
hooks/post-receive
--
matlisp
|
