From 061a969f39f50c365369e28b5182d547f81ee11d Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Sun, 17 Feb 2008 12:46:23 +0100 Subject: Implement OBJCL-CREATE-CLASS. darcs-hash:410094108d1b68697e4bf6c40a92e0d4dfceedba --- Lisp/libobjcl.lisp | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'Lisp/libobjcl.lisp') diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index c4b9d18..1364c58 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -747,6 +747,33 @@ separating parts by hyphens works nicely in all of the `:INVERT`, (defun objcl-class-superclass (class) (objcl-class-superclass/pointer (pointer-to class))) +(defun objcl-create-class (class-name superclass + protocol-names + ivar-names ivar-typespecs) + (let* ((ivar-typestrings (mapcar #'print-typespec-to-string ivar-typespecs))) + (with-foreign-string-pool (register-temporary-string + allocate-temporary-string) + (with-foreign-objects ((%protocol-names :pointer (length protocol-names)) + (%ivar-names :pointer (length ivar-names)) + (%ivar-typestrings :pointer (length ivar-typestrings))) + (flet ((fill-foreign-array-from-list (array list type) + (loop for element in list + for i from 0 + do (setf (mem-aref array type i) element)))) + (loop for (array . list) in (list (cons %protocol-names protocol-names) + (cons %ivar-names ivar-names) + (cons %ivar-typestrings ivar-typestrings)) + do (fill-foreign-array-from-list array + (mapcar #'allocate-temporary-string + list) + :pointer))) + (%objcl-create-class class-name + (pointer-to superclass) + (length protocol-names) + %protocol-names + (length ivar-names) + %ivar-names + %ivar-typestrings))))) ;;; (@* "Low-level Data Conversion") (eval-when (:compile-toplevel :load-toplevel) -- cgit v1.2.3