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

scheme/foreign: allow #f as NULL function pointer, allow callback as cpointer

Browse Source 
svn: r12992

original commit: d596401804242ca39007e56d798e12f3852810f0
This commit is contained in:
Matthew Flatt 2009-01-03 18:51:15 +00:00
parent 0dc7813924
commit 2e250514c6
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mzlib/foreign.ss
View File

@ -477,15 +477,16 @@
(define-syntax-rule (make-it wrap) (define-syntax-rule (make-it wrap)
(make-ctype _fpointer (make-ctype _fpointer
(lambda (x) (lambda (x)
(let ([cb (ffi-callback (wrap x) itypes otype abi)]) (and x
(cond [(eq? keep #t) (hash-set! held-callbacks x cb)] (let ([cb (ffi-callback (wrap x) itypes otype abi)])
[(box? keep) (cond [(eq? keep #t) (hash-set! held-callbacks x cb)]
(let ([x (unbox keep)]) [(box? keep)
(set-box! keep (let ([x (unbox keep)])
(if (or (null? x) (pair? x)) (cons cb x) cb)))] (set-box! keep
[(procedure? keep) (keep cb)]) (if (or (null? x) (pair? x)) (cons cb x) cb)))]
cb)) [(procedure? keep) (keep cb)])
(lambda (x) (wrap (ffi-call x itypes otype abi))))) cb)))
(lambda (x) (and x (wrap (ffi-call x itypes otype abi))))))
(if wrapper (make-it wrapper) (make-it begin))) (if wrapper (make-it wrapper) (make-it begin)))
;; Syntax for the special _fun type: ;; Syntax for the special _fun type: