anchor.diff:                     (format s " [style=dashed, label=\"~A\"]" label))
                    (format s ";~%"))
   
  -               (print-collection-edges (from-node to-collection-accessor)
  +               (print-collection-edges (from-node to-collection-accessor &optional user-label)
                    (loop for cell-or-node in (funcall to-collection-accessor from-node)
                          for to-node = (if (consp cell-or-node)
                                          (cdr cell-or-node)
                                          cell-or-node)
                          for label = (if (consp cell-or-node)
                                        (car cell-or-node)
  -                                     nil)
  +                                     user-label)
                          do
                          (print-edge from-node to-node label)
                          (queue-node to-node)))
  
positive.code:   (declare (ignore prop-stack type-map node-history))
    nil)
  
  ;;; ======================================================================
  ;;;; COLLAPSE-TYPE-GRAPH generic function
  
  ;; COLLAPSE-TYPE-GRAPH removes outgoing "dotted edges" from value-nodes.
  ;; When it has finished running, every value-node should have a set of
  ;; assignment-edges pointing directly to its type-nodes, and nothing else.
  ;;
  ;; We keep a separate node-history and node-path TODO finish this description
  
  (defgeneric collapse-type-graph (node node-history node-path
                                        env-rets env-args env-min
                                        env-props)
    (:documentation
     "Informally, this function collects argument, property, and return nodes down assignment
      paths and deposits them at each type-node that it encounters.
  
      NODE-PATH is the path followed to get to the current node.  Eg, if we have visited
      X, Y, and Z, then upon entry to Z NODE-PATH will be '(Z Y X).
  
      ENV-RETS is a list of return nodes of ancestors.
      ENV-ARGS is a list of assoc-cells (INDEX . NODE) of ancestor arguments nodes.  Note that
      there may be more than one entry per index in ENV-ARGS, so don't actually use ASSOC on it.
      ENV-MIN is the minimum of all ancestor nodes' MIN-CALL-ARITY.
  
      ENV-PROPS is a list of assoc-cells (PROP-NAME . NODE).  Note that there
      may be more than one cell for a given property name, so it's not safe
      to use ASSOC.
  
      The first return value is a list of all the type-nodes that NODE has an assignment-path to.
      The second return value is a list of cons-cells containing edges that should be retained in
      the graph.  (This is necessary when a cycle has been encountered)."))
  
  (defmethod collapse-type-graph :around ((node value-node) node-history node-path
                                          env-rets env-args env-min
                                          env-props)
    (flet ((calc-retain-list ()
             (loop with dst-node = node
                   for src-node in node-path
                   until (eq src-node node)
                   collect (cons src-node dst-node)
                   do (setf dst-node src-node))))
      (cond
        ((member node (node-history-node-list node-history))
         (if (type-node-p node)
           (values (list node) nil)
           (values (value-node-assignments node) nil)))
        ((member node node-path)
         (values nil (calc-retain-list)))
        (t
         (multiple-value-bind (type-nodes retain-list)
             (call-next-method)
           (unless (find node retain-list :key 'car)
             (push node (node-history-node-list node-history)))
           (values type-nodes
                   (remove node retain-list :key 'car)))))))
  
  ;TEST
  (defun show-cells (cell-list)
    (mapcar (lambda (cell)
              (cons (type-graph-node-name (car cell))
                    (type-graph-node-name (cdr cell))))
            cell-list))
  
  (defmethod collapse-type-graph ((node value-node) node-history node-path
                                        env-rets env-args env-min
                                        env-props)
    (let ((own-rets (aif (value-node-return-node node)
                      (cons it env-rets)
                      env-rets))
          (own-args (append (value-node-arguments node)
                            env-args))
          (own-min (min* (value-node-min-call-arity node)
                         env-min))
          (own-props (append (value-node-properties node)
                             env-props))
          (own-path (cons node node-path))
          (downstream-types nil)
          (retain-list nil))
  
      (dolist (child (value-node-assignments node))
        (multiple-value-bind (type-nodes retain-cells)
            (collapse-type-graph child node-history own-path
                                 own-rets own-args own-min
                                 own-props)
          (setf downstream-types (union type-nodes downstream-types))
          (setf retain-list (append retain-list retain-cells))))
  
      (let ((own-extra-edges (mapcar 'cdr (remove-if-not (lambda (cell)
                                                           (eq node (car cell)))
                                                         retain-list))))
        (setf (value-node-assignments node)
              (union downstream-types own-extra-edges))
        (values downstream-types retain-list))))
                
  
  (defmethod collapse-type-graph ((node type-node) node-history node-path
                                        env-rets env-args env-min
                                        env-props)
  
    ;; Return edges
    (let ((own-ret (get-return-node node)))
      (loop for caller-ret in env-rets
            do (add-assignment-edge caller-ret own-ret)))
  
    ;; Undefined argument handling
    (loop for param in (type-node-parameters node)
          for idx upfrom 0
          when (and (numberp env-min)
                    (>= idx env-min))
          do (add-assignment-edge param (get-type-node "undefined")))
  
    ;; Link corresponding arguments and parameters
    ;; TODO Deal with worse-than-quadratic nature of this operation, perhaps
    ;; by using an array for parameters instead of a list.
    (loop for (arg-idx . arg-node) in env-args
          do (add-assignment-edge (nth arg-idx (type-node-parameters node)) arg-node))
  
    ;; Link corresponding properties
    ;; TODO Currently O(n^2); fix by using hash-table for properties
    (loop for (prop-name . prop-node) in env-props
          for own-node = (get-node-property node prop-name)
          do (add-assignment-edge own-node prop-node))
  
    ;; Process nodes connected by "dotted" (ie, non-assignment) edges
    (loop for prop-cell in (type-node-properties node)
          do (collapse-type-graph (cdr prop-cell) node-history nil
                                  nil nil nil nil))
  
    (loop for param in (type-node-parameters node)
          do (collapse-type-graph param node-history nil
                                  nil nil nil nil))
  
    (collapse-type-graph (get-return-node node) node-history nil
                         nil nil nil nil)
  
    (values (list node) nil))
  
    
  ;;; ======================================================================
  
negative.code:                  (unless (find node node-history)
                     (push node node-history)
  
                     (if (value-node-p node)
                       (format s "  ~A [shape=ellipse];~%" (get-name node))
                       (format s "  ~A [shape=box];~%" (get-name node)))
                     
                     (print-collection-edges node 'type-graph-node-properties)
                     
                     (when (type-node-p node)
                       (print-collection-edges node 'type-node-parameters ""))
  
                     (when (value-node-p node)
                       (print-collection-edges node 'value-node-arguments)
  