From 90abe67ff6b3d66b6936358c217467046becd2b3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 20 Dec 2008 05:09:35 +0000 Subject: [PATCH] change _fpointer handling to work with function pointers in structs and other such uses; add 'function-ptr' casting operation svn: r12913 original commit: 82ead03b92f7288fede1aaf6679312fc5d2093f2 --- collects/mzlib/foreign.ss | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/collects/mzlib/foreign.ss b/collects/mzlib/foreign.ss index a01579b..42a9103 100644 --- a/collects/mzlib/foreign.ss +++ b/collects/mzlib/foreign.ss @@ -62,7 +62,7 @@ _void _int8 _uint8 _int16 _uint16 _int32 _uint32 _int64 _uint64 _fixint _ufixint _fixnum _ufixnum _float _double _double* - _bool _pointer _scheme _fpointer + _bool _pointer _scheme _fpointer function-ptr (unsafe memcpy) (unsafe memmove) (unsafe memset) (unsafe malloc-immobile-cell) (unsafe free-immobile-cell)) @@ -676,6 +676,13 @@ (syntax-case stx () [(_ x ...) (begin (set! xs (syntax->list #'(x ...))) (do-fun))])) +(define (function-ptr p fun-ctype) + (if (cpointer? p) + (if (eq? (ctype->layout fun-ctype) 'fpointer) + ((ctype-c->scheme fun-ctype) p) + (raise-type-error 'function-ptr "function ctype" fun-ctype)) + (raise-type-error 'function-ptr "cpointer" p))) + ;; ---------------------------------------------------------------------------- ;; String types