From 2725a0608cb14ad6d6c48ec95a070c8a44b55cf0 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 19 Sep 2009 12:23:45 +0400 Subject: [PATCH] gobject.generating: remove duplicate type definitions from generating --- glib/gobject.generating.lisp | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp index 6cd58e6..c91cdcf 100644 --- a/glib/gobject.generating.lisp +++ b/glib/gobject.generating.lisp @@ -7,6 +7,7 @@ (defvar *generation-exclusions* nil) (defvar *known-interfaces* (make-hash-table :test 'equal)) (defvar *additional-properties* nil) +(defvar *generated-types* nil) (defun name->supplied-p (name) (make-symbol (format nil "~A-SUPPLIED-P" (symbol-name name)))) @@ -242,6 +243,8 @@ (let ((type-init-name (probable-type-init-name type))) (when (foreign-symbol-pointer type-init-name) (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))) + (when *generated-types* + (setf (gethash (g-type-string type) *generated-types*) t)) (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*)) (g-type (ensure-g-type type)) (g-name (g-type-name g-type)) @@ -271,6 +274,8 @@ (let ((type-init-name (probable-type-init-name interface))) (when (foreign-symbol-pointer type-init-name) (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))) + (when *generated-types* + (setf (gethash (g-type-string interface) *generated-types*) t)) (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*)) (type (ensure-g-type interface)) (g-name (g-type-name type)) @@ -289,10 +294,12 @@ (defun get-g-class-definitions-for-root-1 (type) (unless (member type *generation-exclusions* :test 'g-type=) - (cons (get-g-class-definition type) - (reduce #'append - (mapcar #'get-g-class-definitions-for-root-1 - (sort (copy-list (g-type-children type)) #'string< :key #'g-type-string)))))) + (iter (when (first-iteration-p) + (unless (and *generated-types* + (gethash (g-type-string type) *generated-types*)) + (appending (list (get-g-class-definition type))))) + (for child-type in (sort (copy-list (g-type-children type)) #'string< :key #'g-type-string)) + (appending (get-g-class-definitions-for-root-1 child-type))))) (defun get-g-class-definitions-for-root (type) (setf type (ensure-g-type type)) @@ -378,6 +385,8 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec (let ((type-init-name (probable-type-init-name type))) (when (foreign-symbol-pointer type-init-name) (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))) + (when *generated-types* + (setf (gethash (g-type-string type) *generated-types*) t)) (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*)) (g-type (ensure-g-type type)) (g-name (g-type-name g-type)) @@ -427,6 +436,8 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec (let ((type-init-name (probable-type-init-name type))) (when (foreign-symbol-pointer type-init-name) (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))) + (when *generated-types* + (setf (gethash (g-type-string type) *generated-types*) t)) (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*)) (g-type (ensure-g-type type)) (g-name (g-type-name g-type)) @@ -462,6 +473,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec (*lisp-name-exceptions* exceptions) (*print-case* :downcase) (*additional-properties* additional-properties) + (*generated-types* (make-hash-table :test 'equalp)) (referenced-types (and include-referenced (filter-types-by-prefix (get-referenced-types root-type) @@ -517,7 +529,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec (loop for def in (get-g-class-definitions-for-root root-type) do (format file "~S~%~%" def)) - (loop - for object in objects - for def = (get-g-class-definition object) - do (format file "~S~%~%" def))))) \ No newline at end of file + (iter (for object in objects) + (unless (gethash (g-type-string object) *generated-types*) + (for def = (get-g-class-definition object)) + (format file "~S~%~%" def)))))) \ No newline at end of file -- 1.7.10.4