From 44737e7a284d2f1a0ab5e929ddb16bcd9f6ed4f6 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 6 Jan 2005 23:24:10 +0000 Subject: [PATCH] Added a failure-thunk to get-ffi-obj. original commit: 1eba099ab6920434ab816fcd1c187bbcefeb093c --- collects/mzlib/foreign.ss | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.ss index df9b74b..036feb4 100644 --- a/collects/mzlib/foreign.ss +++ b/collects/mzlib/foreign.ss @@ -176,13 +176,29 @@ ;; foreign name into the type syntax, which allows generated wrappers to have a ;; proper name. (provide* (unsafe get-ffi-obj)) -(define (get-ffi-obj* name lib type) +(define (get-ffi-obj* name lib type . failure) (ffi-get (ffi-obj (get-ffi-obj-name 'get-ffi-obj name) (get-ffi-lib lib)) type)) +(define get-ffi-obj* + (case-lambda + [(name lib type) (get-ffi-obj* name lib type #f)] + [(name lib type failure) + (let ([name (get-ffi-obj-name 'get-ffi-obj name)] + [lib (get-ffi-lib lib)]) + (let-values ([(obj error?) + (with-handlers + ([exn:fail:filesystem? + (lambda (e) + (if failure (values (failure) #t) (raise e)))]) + (values (ffi-obj name lib) #f))]) + (if error? obj (ffi-get obj type))))])) (define-syntax (get-ffi-obj stx) (syntax-case stx () [(_ name lib type) #`(get-ffi-obj* name lib #,(syntax-property #`type 'ffi-name #'name))] + [(_ name lib type failure) + #`(get-ffi-obj* name lib #,(syntax-property #`type 'ffi-name #'name) + failure)] [x (identifier? #'x) #'get-ffi-obj*])) ;; It is important to use the set-ffi-obj! wrapper because it takes care of