(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "IL")
(FILECREATED " 1-Feb-98 09:38:12" ("compiled on " 
|{DSK}<disk>disk2>jdstools>lc3>lispcore3.0>internal>library>CONDITIONGRAPH.;3|) "31-Jan-98 19:10:48" 
|bcompl'd| |in| "Medley 31-Jan-98 ..." |dated| "31-Jan-98 19:12:50")
(FILECREATED "14-Jun-90 21:03:42" |{DSK}<usr>local>lde>lispcore>internal>library>CONDITIONGRAPH.;2| 
5185 |changes| |to:| (VARS CONDITIONGRAPHCOMS) |previous| |date:| " 9-Dec-87 16:48:03" 
|{DSK}<usr>local>lde>lispcore>internal>library>CONDITIONGRAPH.;1|)
(PRETTYCOMPRINT CONDITIONGRAPHCOMS)
(RPAQQ CONDITIONGRAPHCOMS ((DECLARE\: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY (XCL:FILE-ENVIRONMENTS 
:CONDITIONGRAPH)) (VARIABLES *CONDITION-GRAPH-WINDOW* *CONDITION-GRAPH-SEXPR*) (FUNCTIONS 
EDIT-CONDITIONS GRAPH-CONDITIONS CONDITION-SUBGRAPH CONDITION-SUBGRAPH-RECURSION 
RECOMPUTE-CONDITION-GRAPH-SEXPR COUNT-CONDITION-TYPES COUNT-CONDITION-TYPES-RECURSION) (PROP 
CONDITIONGRAPH)))
(CL:DEFVAR *CONDITION-GRAPH-WINDOW* NIL "Window in which to display the condition hierarchy graph.")
(CL:DEFVAR *CONDITION-GRAPH-SEXPR* NIL 
"Tree structure representing last calculated condition type graph.")
(CL:DEFUN EDIT-CONDITIONS (ROOT) (CL:LABELS ((EDIT-CONDITIONS-RECURSION (GRAPH) (CL:UNLESS (NULL GRAPH
) (ED (CL:FIRST GRAPH) :STRUCTURES) (CL:MAPC (CL:FUNCTION EDIT-CONDITIONS-RECURSION) (CL:REST GRAPH)))
)) (EDIT-CONDITIONS-RECURSION (CONDITION-SUBGRAPH ROOT NIL))))
(CL:DEFUN GRAPH-CONDITIONS (&OPTIONAL (ROOT (QUOTE CONDITION)) (RECOMPUTE (NULL 
*CONDITION-GRAPH-SEXPR*)) W) (LET ((NEWW (SHOWGRAPH (LAYOUTSEXPR (CONDITION-SUBGRAPH ROOT RECOMPUTE) (
QUOTE (HORIZONTAL))) (OR W *CONDITION-GRAPH-WINDOW* (CL:FORMAT NIL "Condition type graph from: ~S" 
ROOT)) NIL NIL T))) (WINDOWPROP NEWW (QUOTE TITLE) (CL:FORMAT NIL "Condition type graph from: ~S" ROOT
)) (OR W *CONDITION-GRAPH-WINDOW* (CL:SETF *CONDITION-GRAPH-WINDOW* NEWW))))
(CL:DEFUN CONDITION-SUBGRAPH (ROOT RECOMPUTE &AUX (ONCE NIL) RESULT) (CL:UNLESS (CL:SUBTYPEP ROOT (
QUOTE CONDITION)) (CL:ERROR "~S is not a condition type.")) (CL:LOOP (CL:WHEN RECOMPUTE (
RECOMPUTE-CONDITION-GRAPH-SEXPR)) (CL:SETF RESULT (CONDITION-SUBGRAPH-RECURSION ROOT 
*CONDITION-GRAPH-SEXPR*)) (CL:WHEN (OR ONCE RESULT) (CL:RETURN-FROM CONDITION-SUBGRAPH RESULT)) (
CL:FORMAT *ERROR-OUTPUT* "Couldn't find ~S in current graph.") (CL:SETQ ONCE T RECOMPUTE T)))
(CL:DEFUN CONDITION-SUBGRAPH-RECURSION (TARGET TREE) (COND ((NULL TREE) NIL) ((EQ TARGET (CL:FIRST 
TREE)) TREE) (T (CL:DOLIST (SUBTREE (CL:REST TREE)) (LET ((FOUND? (CONDITION-SUBGRAPH-RECURSION TARGET
 SUBTREE))) (CL:WHEN FOUND? (RETURN FOUND?)))))))
(CL:DEFUN RECOMPUTE-CONDITION-GRAPH-SEXPR NIL (LET ((CGHASH (CL:MAKE-HASH-TABLE))) (CL:FORMAT 
*ERROR-OUTPUT* " Computing condition hierarchy graph.") (MAPCAR (DATATYPES) (CL:FUNCTION (CL:LAMBDA (
SYMBOL) (BLOCK) (CL:WHEN (AND (NOT (CL:GETHASH SYMBOL CGHASH)) (CL:SUBTYPEP SYMBOL (QUOTE CONDITION)))
 (CL:DO ((TYPE SYMBOL (CONDITION-PARENT TYPE)) (CHAIN NIL)) ((COND ((NULL TYPE) (CL:SETF 
*CONDITION-GRAPH-SEXPR* CHAIN)) ((CL:GETHASH TYPE CGHASH) (NCONC (CL:GETHASH TYPE CGHASH) (LIST CHAIN)
)) (T NIL))) (CL:PRINC ".") (CL:SETF (CL:GETHASH TYPE CGHASH) (CL:SETF CHAIN (CL:IF (NULL CHAIN) (LIST
 TYPE) (LIST TYPE CHAIN)))))))))))
(CL:DEFUN COUNT-CONDITION-TYPES NIL (COUNT-CONDITION-TYPES-RECURSION (CONDITION-SUBGRAPH (QUOTE 
CONDITION) NIL)))
(CL:DEFUN COUNT-CONDITION-TYPES-RECURSION (TREE) (COND ((NULL TREE) 0) ((CL:SYMBOLP TREE) 1) (T (FOR 
SUBTREE IN TREE SUM (COUNT-CONDITION-TYPES-RECURSION SUBTREE)))))
(PUTPROPS CONDITIONGRAPH COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990))
NIL