42 lines
1.5 KiB
Scheme
42 lines
1.5 KiB
Scheme
(module c-printf mzscheme
|
|
|
|
(require (lib "foreign.ss")) (unsafe!)
|
|
|
|
;; This code demonstrates how to interface `printf' which can be used with
|
|
;; different arities and types. Also, `printf' is unsafe unless this code will
|
|
;; parse the format string and make sure that all the types match, instead,
|
|
;; this code demonstrates how to provide unsafe bindings in a way that forces
|
|
;; users to admit that `(c-printf-is-dangerous!)'.
|
|
|
|
;; It's not too useful, since the C printf will obviously ignore
|
|
;; `current-output-port'.
|
|
|
|
(provide* (unsafe c-printf))
|
|
|
|
(define interfaces (make-hash-table 'equal))
|
|
|
|
(define (c-printf fmt . args)
|
|
(define itypes
|
|
(cons _string
|
|
(map (lambda (x)
|
|
(cond [(integer? x) _int]
|
|
[(and (number? x) (not (complex? x))) _double*]
|
|
[(string? x) _string]
|
|
[(bytes? x) _bytes]
|
|
[(symbol? x) _symbol]
|
|
[else (error 'c-printf
|
|
"don't know how to deal with ~e" x)]))
|
|
args)))
|
|
(let ([printf (hash-table-get interfaces itypes
|
|
(lambda ()
|
|
;; Note: throws away the return value of printf
|
|
(let ([i (get-ffi-obj "printf" #f
|
|
(_cprocedure itypes _void))])
|
|
(hash-table-put! interfaces itypes i)
|
|
i)))])
|
|
(apply printf fmt args)))
|
|
|
|
(define-unsafer c-printf-is-dangerous!)
|
|
|
|
)
|