-(defun find-type-dependencies (type)
- (let ((list-dependencies (second (find-type-info type))))
- (when list-dependencies
- (funcall list-dependencies (find-type-number type t)))))
-
-(defun %sort-types-topologicaly (types)
- (let ((partial-sorted
- (sort
- (mapcar
- #'(lambda (type)
- (cons type (remove-if #'(lambda (dep)
- (not (find dep types)))
- (find-type-dependencies type))))
- types)
- #'(lambda (type1 type2) (type-is-p type2 type1)) :key #'car))
- (sorted ()))
-
- (loop
- as tmp = partial-sorted then (or (rest tmp) partial-sorted)
- while tmp
- do (destructuring-bind (type . dependencies) (first tmp)
- (cond
- ((every #'(lambda (dep)
- (assoc dep sorted))
- dependencies)
- (push (cons type nil) sorted) ; no forward definition needed
- (setq partial-sorted (delete type partial-sorted :key #'first)))
- ((some #'(lambda (dep)
- (find type (find-type-dependencies dep)))
- dependencies)
- (push (cons type t) sorted) ; forward definition needed
- (setq partial-sorted (delete type partial-sorted :key #'first))))))
- (nreverse sorted)))
+(defun find-type-dependencies (type &optional options)
+ (let ((find-dependencies (second (find-type-info type))))
+ (when find-dependencies
+ (remove-duplicates
+ (mapcar #'find-type-number
+ (funcall find-dependencies (find-type-number type t) options))))))
+
+
+;; The argument is a list where each elements is on the form
+;; (type . dependencies). This function will not handle indirect
+;; dependencies and types depending on them selve.
+(defun sort-types-topologicaly (unsorted)
+ (flet ((depend-p (type1)
+ (find-if #'(lambda (type2)
+ (and
+ ;; If a type depends a subtype it has to be
+ ;; forward defined
+ (not (type-is-p (car type2) (car type1)))
+ (find (car type2) (cdr type1))))
+ unsorted)))
+ (let ((sorted
+ (loop
+ while unsorted
+ nconc (multiple-value-bind (sorted remaining)
+ (delete-collect-if
+ #'(lambda (type)
+ (or (not (cdr type)) (not (depend-p type))))
+ unsorted)
+ (cond
+ ((not sorted)
+ ;; We have a circular dependency which have to
+ ;; be resolved
+ (let ((selected
+ (find-if
+ #'(lambda (type)
+ (every
+ #'(lambda (dep)
+ (or
+ (not (type-is-p (car type) dep))
+ (not (find dep unsorted :key #'car))))
+ (cdr type)))
+ unsorted)))
+ (unless selected
+ (error "Couldn't resolve circular dependency"))
+ (setq unsorted (delete selected unsorted))
+ (list selected)))
+ (t
+ (setq unsorted remaining)
+ sorted))))))
+
+ ;; Mark types which have to be forward defined
+ (loop
+ for tmp on sorted
+ as (type . dependencies) = (first tmp)
+ collect (cons type (and
+ dependencies
+ (find-if #'(lambda (type)
+ (find (car type) dependencies))
+ (rest tmp))
+ t))))))