- (let ((type-list
- (delete-if
- #'(lambda (type-number)
- (let ((name (find-foreign-type-name type-number)))
- (or
- (getf (type-options type-number) :ignore)
- (find-if
- #'(lambda (options)
- (and
- (string-prefix-p (first options) name)
- (getf (cdr options) :ignore-prefix)
- (not (some
- #'(lambda (exception)
- (string= name exception))
- (getf (cdr options) :except)))))
- args))))
- (find-types prefix))))
-
- (dolist (type-number type-list)
- (let ((name (find-foreign-type-name type-number)))
- (register-type
- (getf (type-options type-number) :type (default-type-name name))
- (register-type-as type-number))))
-
- ;; This is needed for some unknown reason to get type numbers right
- (mapc #'find-type-dependencies type-list)
-
- (let ((sorted-type-list
- #+clisp (mapcar #'list type-list)
- #-clisp
- (sort-types-topologicaly
- (mapcar
- #'(lambda (type)
- (cons type (find-type-dependencies type (type-options type))))
- type-list))))
- `(progn
- ,@(mapcar
- #'(lambda (pair)
- (destructuring-bind (type . forward-p) pair
- (expand-type-definition type forward-p (type-options type))))
- sorted-type-list)
- ,@(mapcar
- #'(lambda (pair)
- (destructuring-bind (type . forward-p) pair
- (when forward-p
- (expand-type-definition type nil (type-options type)))))
- sorted-type-list))))))
+ (setq type-list
+ (delete-if
+ #'(lambda (type-number)
+ (let ((name (find-foreign-type-name type-number)))
+ (or
+ (getf (type-options type-number) :ignore)
+ (find-if
+ #'(lambda (options)
+ (and
+ (string-prefix-p (first options) name)
+ (getf (cdr options) :ignore-prefix)
+ (not (some
+ #'(lambda (exception)
+ (string= name exception))
+ (getf (cdr options) :except)))))
+ args))))
+ type-list))
+
+ (dolist (type-number type-list)
+ (let ((name (find-foreign-type-name type-number)))
+ (register-type
+ (getf (type-options type-number) :type (default-type-name name))
+ (register-type-as type-number))))
+
+ ;; This is needed for some unknown reason to get type numbers right
+ (mapc #'find-type-dependencies type-list)
+
+ (let ((sorted-type-list
+ #+clisp (mapcar #'list type-list)
+ #-clisp
+ (sort-types-topologicaly
+ (mapcar
+ #'(lambda (type)
+ (cons type (find-type-dependencies type (type-options type))))
+ type-list))))
+ `(progn
+ ,@(mapcar
+ #'(lambda (pair)
+ (destructuring-bind (type . forward-p) pair
+ (expand-type-definition type forward-p (type-options type))))
+ sorted-type-list)
+ ,@(mapcar
+ #'(lambda (pair)
+ (destructuring-bind (type . forward-p) pair
+ (when forward-p
+ (expand-type-definition type nil (type-options type)))))
+ sorted-type-list)))))
+
+(defun expand-types-with-prefix (prefix args)
+ (expand-type-definitions (find-types prefix) args))
+
+(defun expand-types-in-library (system library args)
+ (let* ((filename (library-filename system library))
+ (types (loop
+ for (type-init . %filename) in *type-initializers*
+ when (equal filename %filename)
+ collect (funcall type-init))))
+ (expand-type-definitions types args)))
+
+(defun list-types-in-library (system library)
+ (let ((filename (library-filename system library)))
+ (loop
+ for (type-init . %filename) in *type-initializers*
+ when (equal filename %filename)
+ collect type-init)))