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

.

Browse Source 
original commit: e76331f3abc0a1d9ae2f5091d36b8286b8f3e94f
This commit is contained in:
Eli Barzilay 2004-09-01 10:06:14 +00:00
parent a06af27c72
commit 23c05ab266
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mzlib/foreign.ss
View File

@ -121,14 +121,14 @@
;; ----------------------------------------------------------------------------
;; Function type
;; internal, used by _fun
(define (ffi-fun itypes otype . wrapper)
;; Creates a simple function type that can be used for callouts and callbacks,
;; optionally applying a wrapper function to modify the result primitive
;; (callouts) or the input procedure (callbacks).
(define* (_cprocedure itypes otype . wrapper)
(let ([wrapper (and (pair? wrapper) (car wrapper))])
(if wrapper
(make-ctype _fmark
(lambda (x)
;; (ffi-callback (wrapper x) itypes otype)
(error 'ffi-fun "cannot use wrappers for callback functions (yet)"))
(lambda (x) (ffi-callback (wrapper x) itypes otype))
(lambda (x) (wrapper (ffi-call x itypes otype))))
(make-ctype _fmark
(lambda (x) (ffi-callback x itypes otype))
@ -349,9 +349,9 @@
body 'inferred-name
(string->symbol (string-append "ffi-wrapper:" n)))
body))])
#`(ffi-fun (list #,@(filtmap car inputs)) #,(car output)
#`(_cprocedure (list #,@(filtmap car inputs)) #,(car output)
(lambda (ffi) #,body)))
#`(ffi-fun (list #,@(filtmap car inputs)) #,(car output))))]))
#`(_cprocedure (list #,@(filtmap car inputs)) #,(car output))))]))
;; ----------------------------------------------------------------------------
;; String types