- (let* ((type-number (register-type type id))
- (info (assoc type-number *derivable-type-info*)))
- (if info
- (setf (cdr info) (list query expand))
- (push
- (list type-number query expand)
- *derivable-type-info*))))
-
-(defun type-dependencies (type)
- (let ((query (second (assoc (car (last (type-hierarchy type)))
- *derivable-type-info*))))
- (when query
- (funcall query (find-type-number type t)))))
-
-(defun expand-type-definition (type)
- (let ((expander (third (assoc (car (last (type-hierarchy type)))
- *derivable-type-info*))))
- (funcall expander (find-type-number type t))))
+ (let ((type-number (register-type type id)))
+ (setf (gethash type-number *derivable-type-info*) expander)))
+
+(defun find-type-info (type)
+ (dolist (super (cdr (type-hierarchy type)))
+ (let ((info (gethash super *derivable-type-info*)))
+ (return-if info))))