get-ffi-lib does not expect an ffi-lib input

svn: r3515
This commit is contained in:
Eli Barzilay 2006-06-28 01:14:14 +00:00
parent 4511848bb9
commit 8d9e8b852a

View File

@ -147,7 +147,6 @@
[(name) (get-ffi-lib name "")] [(name) (get-ffi-lib name "")]
[(name version) [(name version)
(cond (cond
[(ffi-lib? name) name]
[(not name) (ffi-lib name)] ; #f => NULL => open this executable [(not name) (ffi-lib name)] ; #f => NULL => open this executable
[(not (or (string? name) (path? name))) [(not (or (string? name) (path? name)))
(raise-type-error 'ffi-lib "library-name" name)] (raise-type-error 'ffi-lib "library-name" name)]
@ -161,7 +160,8 @@
;; file-not-found error. This is because the dlopen doesn't provide a ;; file-not-found error. This is because the dlopen doesn't provide a
;; way to distinguish different errors (only dlerror, but that's ;; way to distinguish different errors (only dlerror, but that's
;; unreliable). ;; unreliable).
(let* ([version (if (pair? version) (string-append "." (car version)) "")] (let* ([version (if (zero? (string-length version))
"" (string-append "." version))]
[fullpath (lambda (p) (path->complete-path (expand-path p)))] [fullpath (lambda (p) (path->complete-path (expand-path p)))]
[absolute? (absolute-path? name)] [absolute? (absolute-path? name)]
[name0 (path->string (expand-path name))] ; orig name [name0 (path->string (expand-path name))] ; orig name
@ -184,6 +184,9 @@
;; give up: call ffi-lib so it will raise an error ;; give up: call ffi-lib so it will raise an error
(ffi-lib name)))])])) (ffi-lib name)))])]))
(define (get-ffi-lib-internal x)
(if (ffi-lib? x) x (get-ffi-lib x)))
;; These internal functions provide the functionality to be used by ;; These internal functions provide the functionality to be used by
;; get-ffi-obj, set-ffi-obj! and define-c below ;; get-ffi-obj, set-ffi-obj! and define-c below
(define (ffi-get ffi-obj type) (define (ffi-get ffi-obj type)
@ -200,7 +203,7 @@
[(name lib) (ffi-obj-ref name lib #f)] [(name lib) (ffi-obj-ref name lib #f)]
[(name lib failure) [(name lib failure)
(let ([name (get-ffi-obj-name 'ffi-obj-ref name)] (let ([name (get-ffi-obj-name 'ffi-obj-ref name)]
[lib (get-ffi-lib lib)]) [lib (get-ffi-lib-internal lib)])
(with-handlers ([exn:fail:filesystem? (with-handlers ([exn:fail:filesystem?
(lambda (e) (if failure (failure) (raise e)))]) (lambda (e) (if failure (failure) (raise e)))])
(ffi-obj name lib)))])) (ffi-obj name lib)))]))
@ -211,17 +214,29 @@
(provide* (unsafe get-ffi-obj)) (provide* (unsafe get-ffi-obj))
(define get-ffi-obj* (define get-ffi-obj*
(case-lambda (case-lambda
[(name lib type) (get-ffi-obj* name lib type #f)] [(name lib type)
(let ([name (get-ffi-obj-name 'get-ffi-obj name)]
[lib (get-ffi-lib-internal lib)])
(ffi-get (ffi-obj name lib) type))]
[(name lib type failure) [(name lib type failure)
(let ([name (get-ffi-obj-name 'get-ffi-obj name)] (let ([name (get-ffi-obj-name 'get-ffi-obj name)]
[lib (get-ffi-lib lib)]) [lib (get-ffi-lib-internal lib)])
(let-values ([(obj error?) (let ([(obj error?)
(with-handlers (with-handlers ([exn:fail:filesystem?
([exn:fail:filesystem? (lambda (e) (values (failure) #t))])
(lambda (e)
(if failure (values (failure) #t) (raise e)))])
(values (ffi-obj name lib) #f))]) (values (ffi-obj name lib) #f))])
(if error? obj (ffi-get obj type))))])) (if error? obj (ffi-get obj type))))]))
(define (get-ffi-obj* name lib type . failure)
(let ([name (get-ffi-obj-name 'get-ffi-obj name)]
[lib (get-ffi-lib-internal lib)])
(let-values ([(obj error?)
(with-handlers ([exn:fail:filesystem?
(lambda (e)
(if (pair? failure)
(values ((car failure)) #t)
(raise e)))])
(values (ffi-obj name lib) #f))])
(if error? obj (ffi-get obj type)))))
(define-syntax (get-ffi-obj stx) (define-syntax (get-ffi-obj stx)
(syntax-case stx () (syntax-case stx ()
[(_ name lib type) [(_ name lib type)
@ -236,7 +251,8 @@
;; crash when the Scheme function is gone. ;; crash when the Scheme function is gone.
(provide* (unsafe set-ffi-obj!)) (provide* (unsafe set-ffi-obj!))
(define (set-ffi-obj! name lib type new) (define (set-ffi-obj! name lib type new)
(ffi-set! (ffi-obj (get-ffi-obj-name 'set-ffi-obj! name) (get-ffi-lib lib)) (ffi-set! (ffi-obj (get-ffi-obj-name 'set-ffi-obj! name)
(get-ffi-lib-internal lib))
type new)) type new))
;; Combining the above two in a `define-c' special form which makes a Scheme ;; Combining the above two in a `define-c' special form which makes a Scheme
@ -244,7 +260,7 @@
(provide* (unsafe make-c-parameter)) (provide* (unsafe make-c-parameter))
(define (make-c-parameter name lib type) (define (make-c-parameter name lib type)
(let ([obj (ffi-obj (get-ffi-obj-name 'make-c-parameter name) (let ([obj (ffi-obj (get-ffi-obj-name 'make-c-parameter name)
(get-ffi-lib lib))]) (get-ffi-lib-internal lib))])
(case-lambda [() (ffi-get obj type)] (case-lambda [() (ffi-get obj type)]
[(new) (ffi-set! obj type new)]))) [(new) (ffi-set! obj type new)])))
;; Then the fake binding syntax, uses the defined identifier to name the ;; Then the fake binding syntax, uses the defined identifier to name the