From 164950db293f283e5d1be7a9d6262ef1a331f359 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 16 Sep 2007 18:34:04 +0200 Subject: Add classes for tagged pointers. darcs-hash:93dc7a7ee851ab3947332487b00b990143b81e46 --- Lisp/data-types.lisp | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) (limited to 'Lisp/data-types.lisp') diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index c757070..1095e38 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -154,6 +154,52 @@ an __exception__, you can simply send it the `self' message. __id__")) +(defclass opaque-struct (c-pointer-wrapper) + ((name :type (or null string) + :accessor struct-name + :initarg :name))) + +(defclass tagged-struct (c-pointer-wrapper) + ((name :type (or null string) + :accessor struct-name + :initarg :name) + (children :type list + :accessor struct-children + :initarg :children))) + +(defclass opaque-union (c-pointer-wrapper) + ((name :type (or null string) + :accessor struct-name + :initarg :name))) + +(defclass tagged-union (c-pointer-wrapper) + ((name :type (or null string) + :accessor struct-name + :initarg :name) + (children :type list + :accessor struct-children + :initarg :children))) + +(defclass tagged-array (c-pointer-wrapper) + ((element-type :type symbol + :accessor tagged-array-element-type + :initarg :element-type))) + + +(defgeneric type-info (thing)) + +(defmethod type-info ((thing opaque-struct)) + (with-slots (name) + thing + (list* 'struct '(opaque) name))) + +(defmethod type-info ((thing tagged-struct)) + (with-slots (name children) + thing + (list* 'struct '() name (mapcar #'type-info children)))) + + + (defgeneric objcl-eql (obj1 obj2)) (defmethod objcl-eql ((obj1 c-pointer-wrapper) (obj2 c-pointer-wrapper)) (pointer-eq (pointer-to obj1) (pointer-to obj2))) -- cgit v1.2.3