sample c-printf interface

svn: r1020

collects/ffi/c-printf.ss

@@ -0,0 +1,41 @@
+(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!)
+
+)

collects/ffi/examples/c-printf.ss

@@ -0,0 +1,14 @@
+#!/bin/sh
+#|
+exec mzscheme -r "$0" "$@"
+|#
+
+(require (lib "c-printf.ss" "ffi"))
+
+(c-printf-is-dangerous!) ; see last example below
+
+(c-printf "|%4d| |%04d| |%-4d|\n" 12 34 56)
+(c-printf "|%4d| |%04d| |%-4d|\n" "12" "34" "56")
+(c-printf "Bye bye sanity:\n")
+(c-printf "%s\n" 0)
+(c-printf "%s\n" 1234)