Re: Proposal WITH-CASTED-POINTER (Was: Coercing pointers)

On Wed, 13 Aug 2003 20:51:53 -0400, Matthew Danish <[email protected]> wrote:

> One nit: I don't think there is a word `casted'.  The past form of
> `to cast' is 'cast'.

Oops, I once knew that but my memory seems to fade away more and
more. Next time I'll propose German names... :)

Here's a corrected patch.

Cheers,
Edi.


edi@bird:/usr/local/lisp/source/uffi/src > diff -ru /tmp/uffi-1.2.21/ /usr/local/lisp/source/uffi
diff -ru /tmp/uffi-1.2.21/src/objects.lisp /usr/local/lisp/source/uffi/src/objects.lisp
--- /tmp/uffi-1.2.21/src/objects.lisp   Tue Jul  8 14:37:26 2003
+++ /usr/local/lisp/source/uffi/src/objects.lisp        Thu Aug 14 00:00:17 2003
@@ -197,3 +197,33 @@
   `(with-foreign-objects ((,var ,type))
      ,@body))

+#+lispworks
+(defmacro with-cast-pointer ((pointer type &optional binding-name) &body body)
+  `(fli:with-coerced-pointer (,(or binding-name pointer)
+                          :type ',(convert-from-uffi-type (eval type) :type))
+      ,pointer
+    ,@body))
+
+#+(or cmu scl sbcl)
+(defmacro with-cast-pointer ((pointer type &optional binding-name) &body body)
+  `(let ((,(or binding-name pointer)
+          (#+(or cmu scl) alien:cast
+           #+sbcl sb-alien:cast
+           ,pointer (* ,(convert-from-uffi-type (eval type) :type)))))
+    ,@body))
+
+#+allegro
+(defmacro with-cast-pointer ((pointer type &optional binding-name) &body body)
+  (declare (ignore type))
+  (cond (binding-name
+          `(let ((,binding-name ,pointer))
+            ,@body))
+        (t
+          `(progn
+            ,@body))))
+
+#-(or lispworks cmu scl sbcl allegro)
+(defmacro with-cast-pointer ((pointer type &optional binding-name) &body body)
+  '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
+          (lisp-implementation-type)))
+
diff -ru /tmp/uffi-1.2.21/src/package.lisp /usr/local/lisp/source/uffi/src/package.lisp
--- /tmp/uffi-1.2.21/src/package.lisp   Sat Jun  7 00:06:28 2003
+++ /usr/local/lisp/source/uffi/src/package.lisp        Wed Aug 13 16:45:23 2003
@@ -49,6 +49,7 @@
    #:make-null-pointer
    #:+null-cstring-pointer+
    #:char-array-to-pointer
+   #:with-cast-pointer

    ;; string functions
    #:convert-from-cstring