anchor.diff:  
   ;;;; 
   
  -(defvar *derivable-type-info* ())
  -
  -(defun register-derivable-type (type id &key query expand)
  +(defvar *derivable-type-info* (make-hash-table))
  +
  +(defun register-derivable-type (type id expander)
     (register-type type id)
  -  (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*))))
  +  (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 (assoc super *derivable-type-info*)))
  +    (let ((info (gethash super *derivable-type-info*)))
         (return-if info))))
   
  -(defun type-dependencies (type)
  -  (let ((query (second (find-type-info type))))
  -    (when query
  -      (funcall query (find-type-number type t)))))
  -
  -(defun expand-type-definition (type)
  -  (let ((expander (third (find-type-info type))))
  -    (funcall expander (find-type-number type t))))
  +(defun expand-type-definition (type options)
  +  (let ((expander (find-type-info type)))
  +    (funcall expander (find-type-number type t) options)))
   
   (defbinding type-parent (type) type-number
     ((find-type-number type t) type-number))
  
positive.code: 
  
  (defun expand-type-definitions (prefix &optional args)
    (flet ((type-options (type-number)
  	   (let ((name (find-type-name type-number)))
  	     (cdr (assoc name args :test #'string=)))))
  
      (let ((type-list
  	   (delete-if
  	    #'(lambda (type-number)
  		(let ((name (find-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)))
  		    args))))
  	    (find-types prefix))))
               
        (dolist (type-number type-list)
  	(let ((name (find-type-name type-number)))
  	  (register-type
  	   (getf (type-options type-number) :type (default-type-name name))
  	   type-number)))
  
        `(progn
  	 ,@(mapcar
  	    #'expand-type-definition
  	    (%sort-types-topologicaly type-list))))))
  	    
  (defmacro define-types-by-introspection (prefix &rest args)
    (expand-type-definitions prefix args))
  
negative.code: 
  (defun find-types (prefix)
    (let ((type-list nil))
      (maphash
       #'(lambda (type-number expander)
  	 (declare (ignore expander))
  	 (map-subtypes
  	  #'(lambda (type-number)
  	      (pushnew type-number type-list))
  	  type-number prefix))
       *derivable-type-info*)
      type-list))
  
  (defun %sort-types-topologicaly (unsorted)
    (let ((sorted ()))
      (loop while unsorted do
        (dolist (type unsorted)
  	(let ((dependencies (rest (type-hierarchy type))))
  	  (cond
  	   ((null dependencies)
  	    (push type sorted)
  	    (setq unsorted (delete type unsorted)))
  	   (t
  	    (unless (dolist (dep dependencies)
  		      (when (find type (rest (type-hierarchy dep)))
  			(error "Cyclic type dependencie"))
  		      (return-if (find dep unsorted)))
  	      (push type sorted)
  	      (setq unsorted (delete type unsorted))))))))
  