The attached patch adds a :type attribute to foreign libraries(:system or :wrapper), per-library search paths(needed for cffi-grovel wrappers) and a function list-foreign-libraries. It also adds the readers foreign-library-type, foreign-library-search-path and foreign-library-loaded-p. Any objections against merging this ?
-- Stelian Ionescu a.k.a. fe[nl]ix Quidquid latine dictum sit, altum videtur. http://common-lisp.net/project/iolib
diff -rN -u old-cffi/src/libraries.lisp new-cffi/src/libraries.lisp
--- old-cffi/src/libraries.lisp 2009-07-09 13:44:30.019302872 +0200
+++ new-cffi/src/libraries.lisp 2009-07-09 13:44:30.025972319 +0200
@@ -104,7 +104,8 @@
(defclass foreign-library ()
((spec :initarg :spec)
(options :initform nil :initarg :options)
- (handle :initarg :handle :accessor foreign-library-handle)))
+ (handle :initform nil :initarg :handle
+ :accessor foreign-library-handle)))
(defun get-foreign-library (lib)
"Look up a library by NAME, signalling an error if not found."
@@ -129,16 +130,47 @@
(append (cddr (%foreign-library-spec lib))
(slot-value lib 'options)))
-;;; Warn about unkown options.
+(defun foreign-library-type (lib)
+ (getf (foreign-library-options (get-foreign-library lib)) :type))
+
+(defun foreign-library-search-path (lib)
+ (getf (foreign-library-options (get-foreign-library lib)) :search-path))
+
+(defun foreign-library-loaded-p (lib)
+ (not (null (foreign-library-handle (get-foreign-library lib)))))
+
+(defun list-foreign-libraries (&key (loaded-only t) type)
+ "Return a list of defined foreign libraries.
+If LOADED-ONLY is non-null only loaded libraries are returns.
+TYPE restricts the output to a specific library type(:SYSTEM or :WRAPPER).
+If NIL all libraries are returned."
+ (let ((libs (hash-table-values *foreign-libraries*)))
+ (remove-if-not (lambda (lib)
+ (cond
+ (type
+ (eql type (getf (foreign-library-options lib) :type)))
+ (loaded-only
+ (foreign-library-loaded-p lib))
+ (t t)))
+ libs)))
+
(defmethod initialize-instance :after ((lib foreign-library) &key)
- (loop for (opt nil)
- on (append (slot-value lib 'options)
- (mapcan (lambda (x) (copy-list (cddr x)))
- (slot-value lib 'spec)))
- by #'cddr
- when (not (member opt '(:cconv :calling-convention)))
- do (warn "Unkown option: ~A" opt)))
+ (with-slots (options spec) lib
+ (destructuring-bind (&key type search-path &allow-other-keys)
+ (apply #'append options
+ (mapcar (lambda (x) (copy-list (cddr x)))
+ spec))
+ (flet ((set-option (key value)
+ (if value (setf (getf options key) value) (remf options key))))
+ (assert (subsetp (loop for (key . nil) on options by #'cddr collect key)
+ '(:cconv :calling-convention :type :search-path)))
+ (if type
+ (check-type type (member :system :wrapper))
+ (set-option :type :system))
+ (set-option :search-path (mapcar #'pathname search-path))))))
+;;; FIXME: re-evaluating DEFINE-FOREIGN-LIBRARY overwrites the current entry
+;;; breaking FOREIGN-LIBRARY-LOADED-P if already loaded
(defmacro define-foreign-library (name-and-options &body pairs)
"Defines a foreign library NAME that can be posteriorly used with
the USE-FOREIGN-LIBRARY macro."
@@ -189,14 +221,15 @@
;;; FIXME: haven't double checked whether all Lisps signal a
;;; SIMPLE-ERROR on %load-foreign-library failure. In any case they
;;; should be throwing a more specific error.
-(defun load-foreign-library-path (name path)
+(defun load-foreign-library-path (name path &optional search-path)
"Tries to load PATH using %LOAD-FOREIGN-LIBRARY which should try and
find it using the OS's usual methods. If that fails we try to find it
ourselves."
(handler-case
(%load-foreign-library name path)
(error (error)
- (if-let (file (find-file path *foreign-library-directories*))
+ (if-let (file (find-file path (append search-path
+ *foreign-library-directories*)))
(handler-case
(%load-foreign-library name (native-namestring file))
(simple-error (error)
@@ -227,23 +260,26 @@
(or (cdr (assoc-if #'featurep *cffi-feature-suffix-map*))
(fl-error "Unable to determine the default library suffix on this OS.")))
-(defun load-foreign-library-helper (name thing)
+(defun load-foreign-library-helper (name thing &optional search-path)
(etypecase thing
(string
- (load-foreign-library-path name thing))
+ (load-foreign-library-path name thing search-path))
(pathname
- (load-foreign-library-path name (namestring thing)))
+ (load-foreign-library-path name (namestring thing) search-path))
(cons
(ecase (first thing)
(:framework (load-darwin-framework name (second thing)))
(:default
(unless (stringp (second thing))
(fl-error "Argument to :DEFAULT must be a string."))
- (load-foreign-library-path
- name (concatenate 'string (second thing) (default-library-suffix))))
+ (load-foreign-library-path name
+ (concatenate 'string
+ (second thing)
+ (default-library-suffix))
+ search-path))
(:or (try-foreign-library-alternatives name (rest thing)))))))
-(defun load-foreign-library (library)
+(defun load-foreign-library (library &key search-path)
"Loads a foreign LIBRARY which can be a symbol denoting a library defined
through DEFINE-FOREIGN-LIBRARY; a pathname or string in which case we try to
load it directly first then search for it in *FOREIGN-LIBRARY-DIRECTORIES*;
@@ -255,11 +291,19 @@
(spec (foreign-library-spec lib)))
(when spec
(setf (foreign-library-handle lib)
- (load-foreign-library-helper library spec))
+ (load-foreign-library-helper
+ library spec (foreign-library-search-path lib)))
lib)))
(t
- (make-instance 'foreign-library :spec (list (list library))
- :handle (load-foreign-library-helper nil library))))
+ (let* ((lib-name (gensym (string '#:library-)))
+ (lib
+ (make-instance 'foreign-library :spec `((t ,library))
+ :options `(:type :system
+ :search-path ,search-path)
+ :handle (load-foreign-library-helper
+ lib-name library search-path))))
+ (setf (get-foreign-library lib-name) lib)
+ lib)))
;; Offer these restarts that will retry the call to
;; LOAD-FOREIGN-LIBRARY.
(retry ()
diff -rN -u old-cffi/src/package.lisp new-cffi/src/package.lisp
--- old-cffi/src/package.lisp 2009-07-09 13:44:30.019302872 +0200
+++ new-cffi/src/package.lisp 2009-07-09 13:44:30.025972319 +0200
@@ -32,7 +32,8 @@
(:import-from #:alexandria
#:ensure-list #:featurep #:format-symbol #:if-let
#:make-gensym-list #:once-only #:parse-body #:symbolicate
- #:when-let #:with-unique-names #:lastcar)
+ #:when-let #:with-unique-names #:lastcar
+ #:hash-table-values #:make-keyword)
(:export
;; Types.
#:foreign-pointer
@@ -74,11 +75,16 @@
;; Foreign library operations.
#:*foreign-library-directories*
#:*darwin-framework-directories*
+ #:foreign-library
+ #:foreign-library-type
+ #:foreign-library-search-path
+ #:foreign-library-loaded-p
#:define-foreign-library
#:load-foreign-library
#:load-foreign-library-error
#:use-foreign-library
#:close-foreign-library
+ #:list-foreign-libraries
;; Callbacks.
#:callback
signature.asc
Description: This is a digitally signed message part
_______________________________________________ cffi-devel mailing list cffi-devel@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/cffi-devel
