suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

redoing proper changes

Browse Source 
svn: r3533
This commit is contained in:
Eli Barzilay 2006-06-28 21:01:38 +00:00
parent 15d77a629e
commit ed80f4a945
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mzlib/foreign.ss
View File

@ -147,7 +147,6 @@
[(name) (get-ffi-lib name "")]
[(name version)
(cond
[(ffi-lib? name) name]
[(not name) (ffi-lib name)] ; #f => NULL => open this executable
[(not (or (string? name) (path? 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
;; way to distinguish different errors (only dlerror, but that's
;; 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)))]
[absolute? (absolute-path? name)]
[name0 (path->string (expand-path name))] ; orig name
@ -184,6 +184,9 @@
;; give up: call ffi-lib so it will raise an error
(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
;; get-ffi-obj, set-ffi-obj! and define-c below
(define (ffi-get ffi-obj type)
@ -200,7 +203,7 @@
[(name lib) (ffi-obj-ref name lib #f)]
[(name lib failure)
(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?
(lambda (e) (if failure (failure) (raise e)))])
(ffi-obj name lib)))]))
@ -236,7 +239,8 @@
;; crash when the Scheme function is gone.
(provide* (unsafe set-ffi-obj!))
(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))
;; Combining the above two in a `define-c' special form which makes a Scheme
@ -244,7 +248,7 @@
(provide* (unsafe make-c-parameter))
(define (make-c-parameter name lib type)
(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)]
[(new) (ffi-set! obj type new)])))
;; Then the fake binding syntax, uses the defined identifier to name the