%!
% Date: Sat, 28 Nov 87 00:07:48 EST
% To: NeWS-makers@brillig.umd.edu
% Subject: Finding circularities in your postscript
% Summary: Help with the garbage!
% From: singer@spar.SPAR.SLB.COM (David Singer)
% 
% It seems that circular structures can remain un-reclaimed by the garbage
% collector even when you have discarded all pointers into them.  I wrote this
% slow, simple, piece of code to help find such circularities (and thus,
% one hopes, work out how to remove them).  It's written in LispScript, but
% since the LispScript program isn't available generally, I've included the
% generated postscript.  Have fun.
% 
% ;;
% ;; Routine to find circular structures in postscript.  A top-level
% ;;  structure is searched, with its children, to the specified depth.
% ;;  Circular structures are reported by printing a description of them.
% 
% (defun circular-member (v ar depth k)
%   (let ((l (length ar))
% 	(ans (false)))
%     (for (add depth 1) 1 (sub l 1)
% 	 (lambda (x)
% 	   (if (eq (get ar x) v)
% 	       (let ()
% 		 (printf "Circularity from key %:
% " [ k ])
% 		 (for (add depth 1) 1 x
% 		      (lambda (y)
% 			(printf "  % %
% " [ (get ar y) (typeof (get ar y)) ])))))
% 	   (setq ans (or ans (eq (get ar x) v)))))
%     ans))
% 
% (defun circular-follow (item depth ar v k)
%   (foreign circular-1 (item depth ar) ())
%   ;;(pause)
%   (put ar depth v)
%   (if (and (not (circular-member v ar depth k))
% 	   (gt depth 0))
%       (circular-1 v (sub depth 1) ar)))
% 
% (defun circular-1 (item depth ar)
%   (if (eq (type item) 'arraytype)
%       (for 0 1 (sub (length item) 1)
% 	   (lambda (k)
% 		(circular-follow item depth ar (get item k) k)))
%     (if (or* (eq (type item) 'dicttype)
% 	     (eq (type item) 'eventtype)
% 	     ;;(eq (type item) 'canvastype)
% 	     )
% 	     (forall item
% 		     (lambda (k v)
% 		       (circular-follow item depth ar v k))))))
% 
% ;;; Here's the user entry point.  Item is any structured item (array, dict,
% ;;;   event or canvas).
% ;;;
% (defun circular (item depth)
%   (let ((ar (array (add 1 depth))))
%     (put ar depth item)
%     (circular-1 item (sub depth 1) ar)))
% 
% --------
%! Lispscript generated file

/circular-member { 
    false 3 index length 3 index 1 add 1 2 index 1 sub { 
        5 index
        1 index get 7 index eq { 
            (Circularity from key %:\n) [ 5 index ] printf 4 index
            1 add 1 2 index { 
                (  % %\n) [ 8 index 3 index get 9 index 4 index get typeof ]
                printf pop 
            } for 
        } if 
        2 index 6 index 2 index get 8 index eq or 4 -1 roll pop 3
        1 roll pop 
    } for pop mark 6 2 roll cleartomark 
} def 
/circular-follow { 
    2 index
    4 index 3 index put 1 index 3 index 5 index 3 index circular-member not 4 index
    0 gt and { 
        1 index 4 index 1 sub 4 index circular-1 
    } if 
    5 { 
        pop 
    } repeat 
} def
/circular-1 { 
    2 index type /arraytype eq { 
        0 1 4 index length 1 sub { 
            3 index 3
            index 3 index 6 index 4 index get 4 index circular-follow pop 
        } for 
    } { 
        2 index
        type /dicttype eq 3 index type /eventtype eq or { 
            2 index { 
                4 index 4 index 4
                index 3 index 5 index circular-follow pop pop 
            } forall 
        } if 
    } ifelse 
    pop pop
    pop 
} def 
/circular { 
    1 1 index add array dup 2 index 4 index put 2 index 2
    index 1 sub 2 index circular-1 pop pop pop 
} def
%%