anchor.diff:    (make-instance 'unwind-protect-ast
   		 :protected-ast (convert (cadr form) environment)
   		 :cleanup-form-asts (convert-sequence (cddr form) environment)))
  +
  +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  +;;;
  +;;; Drawing an AST.
  +
  +(defparameter *table* nil)
  +
  +(defun id (ast)
  +  (symbol-name (gethash ast *table*)))
  +
  +(defgeneric draw-ast (ast stream))
  +
  +(defun draw (ast filename)
  +  (with-open-file (stream filename :direction :output :if-exists :supersede)
  +    (format stream "digraph G {~%   ordering = out;~%")
  +    (let ((*table* (make-hash-table :test #'eq)))
  +      (draw-ast ast stream))
  +    (format stream "}~%")))
  +
  +(defmethod draw-ast :around (ast stream)
  +  (when (null (gethash ast *table*))
  +    (setf (gethash ast *table*) (gensym))
  +    (format stream "  ~a [shape = box];~%"
  +	    (id ast))
  +    (call-next-method)))
  +
  +(defmethod draw-ast ((ast constant-ast) stream)
  +  (format stream "   ~a [label = \"~a\"];~%"
  +	  (id ast)
  +	  (value ast)))
  +
  +(defun draw-location (location stream)
  +  (when (null (gethash location *table*))
  +    (setf (gethash location *table*) (gensym))
  +    (format stream "  ~a [shape = circle];~%" (id location))
  +    (format stream "  ~a [label = \"\"];~%" (id location))))
  +
  +(defmethod draw-ast ((ast typed-location-ast) stream)
  +  (format stream "   ~a [label = \"location\"];~%"
  +	  (id ast))
  +  (draw-location (location ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (location ast))))
  +  
  +(defmethod draw-ast ((ast if-ast) stream)
  +  (format stream "   ~a [label = \"if\"];~%"
  +	  (id ast))
  +  (draw-ast (test ast) stream)
  +  (draw-ast (then ast) stream)
  +  (draw-ast (else ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (test ast)))
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (then ast)))
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (else ast))))
  +
  +(defmethod draw-ast ((ast progn-ast) stream)
  +  (format stream "   ~a [label = \"progn\"];~%"
  +	  (id ast))
  +  (loop for child in (form-asts ast)
  +	do (draw-ast child stream)
  +	   (format stream "   ~a -> ~a~%"
  +		   (id ast) (id child))))
  +
  +(defmethod draw-ast ((ast function-call-ast) stream)
  +  (format stream "   ~a [label = \"funcall\"];~%"
  +	  (id ast))
  +  (let ((location (function-location ast)))
  +    (draw-location location stream)
  +    (format stream "   ~a -> ~a~%" (id ast) (id location)))
  +  (loop for child in (arguments ast)
  +	do (draw-ast child stream)
  +	   (format stream "   ~a -> ~a~%"
  +		   (id ast) (id child))))
  +
  +(defmethod draw-ast ((ast block-ast) stream)
  +  (format stream "   ~a [label = \"block\"];~%"
  +	  (id ast))
  +  (draw-ast (body ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (body ast))))
  +  
  +(defmethod draw-ast ((ast return-from-ast) stream)
  +  (format stream "   ~a [label = \"return-from\"];~%"
  +	  (id ast))
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (block-ast ast)))
  +  (draw-ast (form-ast ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (form-ast ast))))
  +  
  +(defmethod draw-ast ((ast setq-ast) stream)
  +  (format stream "   ~a [label = \"setq\"];~%"
  +	  (id ast))
  +  (draw-location (location ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (location ast)))
  +  (draw-ast (value-ast ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (value-ast ast))))
  +  
  +(defmethod draw-ast ((ast code-ast) stream)
  +  (format stream "   ~a [label = \"code\"];~%"
  +	  (id ast))
  +  (loop for location in (required (lambda-list ast))
  +	do (draw-location location stream))
  +  (loop for location in (required (lambda-list ast))
  +	do (format stream "   ~a -> ~a~%"
  +		   (id ast)
  +		   (id location)))
  +  (draw-ast (body-ast ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (body-ast ast))))
  +  
  +(defmethod draw-ast ((ast close-ast) stream)
  +  (format stream "   ~a [label = \"close\"];~%"
  +	  (id ast))
  +  (draw-ast (code-ast ast) stream)
  +  (format stream "   ~a -> ~a~%"
  +	  (id ast)
  +	  (id (code-ast ast))))
  +  
  
positive.code:    #:ast
     #:constant-ast #:value
     #:typed-location-ast
     #:function-call-ast #:binding #:arguments
     #:block-ast #:binding #:body
     #:catch-ast
     #:eval-when-ast
     #:function-ast
     #:go-ast
     #:if-ast #:test #:then #:else
     #:load-time-value-ast
     #:progn-ast #:forms
     #:return-from-ast #:form
     #:setq-ast
     #:tagbody-ast #:items
     #:the-ast
     #:throw-ast
     #:unwind-protect-ast
     ))
  
  (in-package #:sicl-compiler-phase-1)
  
negative.code:   (let ((forms (convert-sequence (cddr form) environment)))
      (make-instance 'eval-when-ast
  		   :situations (cadr form)
  		   :body (make-instance 'progn-ast :form-asts forms))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  