printing closures

[smh@franz.com (Steve Haflich)]

   I've assigned a problem to my AI Programming class using
   continuations, and it would sure help them if there was some way to
   print a closure (i.e. the result of calling (function (lambda ...)))
   so that you can see the lambda expression and the bindings, and so
   that if the value of a binding is a closure it is recursively printed
   in this nice form.  I had something hacked up for older versions of
   Allegro that depended on the closures being represented as s-exprs,
   but of course that won't work anymore.  If I even had access functions
   to get at the fields of a closure I could do this.

Of course, there is no portable way to reach inside any function, much
less a closure, because the internal representation of a function
object is implementation dependent.  The following shows how you might
nonetheless convince the printer to do what you want.  It ought work
in Allegro versions 4.0 and later.  It only attempts to handle
interpreted functions, of course, because for compiled functions the
original lambda expression may no longer even exist.  The closure
variable list in an interpreted closure is essentially an alist.

====================
Allegro CL 4.1 [Sun4; R1] (10/16/91 17:57)
Copyright (C) 1985-1991, Franz Inc., Berkeley, CA, USA.  All Rights Reserved.

user(1): (defun interpreted-closure-p (f)
	   (when (functionp f)
	     (let ((code (excl::fn_code f)))
	       (and (consp code)
		    (eq (car code) 'excl::.lexical-closure.)))))
interpreted-closure-p
user(2): (defun print-interpreted-closure (stm f)
	   (destructuring-bind (ignore1 lambda-expr vars &rest ignore2)
	       (excl::fn_code f)
	     (declare (ignore ignore1 ignore2))
	     (print-unreadable-object (f stm :type t :identity *print-escape*)
	       (format stm "~_~W ~_~W ~_~W~_"
		       (excl::fn_symdef f)
		       lambda-expr
		       vars))))
print-interpreted-closure
user(3): (set-pprint-dispatch '(satisfies interpreted-closure-p)
			      'print-interpreted-closure
			      5)
nil
user(4): (defun adder (n)
	   #'(lambda (x) (+ n x)))
adder
user(5): (adder 123)
#<function (:internal adder) (lambda (x) (+ n x)) ((n . 123)) @ #x14d4826>
user(6):