From 588e3b23a565317c39ca9f33a8659a517f5e028f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 18 Dec 2008 20:05:21 +0000
Subject: [PATCH] ctype->layout in scheme/foreign; prototype Objective-C
 binding in ffi collection

svn: r12890

original commit: 2c95f77c3141a0827bd094d8d93b3e3fa39ef8b5
---
 collects/mzlib/foreign.ss | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.ss
index 8737faa..fa2520d 100644
--- a/collects/mzlib/foreign.ss
+++ b/collects/mzlib/foreign.ss
@@ -58,7 +58,7 @@
           (unsafe malloc) (unsafe free) (unsafe end-stubborn-change)
           cpointer? ptr-equal? ptr-add (unsafe ptr-ref) (unsafe ptr-set!)
           ptr-offset ptr-add! offset-ptr? set-ptr-offset!
-          ctype? make-ctype make-cstruct-type (unsafe make-sized-byte-string)
+          ctype? make-ctype make-cstruct-type (unsafe make-sized-byte-string) ctype->layout
           _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64
           _fixint _ufixint _fixnum _ufixnum
           _float _double _double*
@@ -1494,6 +1494,26 @@
                     (if v (apply values v) (msg/fail-thunk))))]
             [else (msg/fail-thunk)]))))
 
+;; ----------------------------------------------------------------------------
+;;
+
+(define prim-synonyms
+  #hasheq((double* . double)
+          (fixint . long)
+          (ufixint . ulong)
+          (fixnum . long)
+          (ufixnum . ulong)
+          (path . bytes)
+          (symbol . bytes)
+          (scheme . pointer)))
+
+(define (ctype->layout c)
+  (let ([b (ctype-basetype c)])
+    (cond
+     [(ctype? b) (ctype->layout b)]
+     [(list? b) (map ctype->layout b)]
+     [else (hash-ref prim-synonyms b b)])))
+
 ;; ----------------------------------------------------------------------------
 ;; Misc utilities