(FILECREATED "10-Feb-86 17:48:37" {ERIS}<PROLOGCORE>DEMOS>PROLOGGRAPH.;1 3255   

      changes to:  (VARS PROLOGGRAPHCOMS)
                   (FNS PROLOG-TRACE)

      previous date: "17-Jul-85 12:56:44" {MARXC}</USER/JELLINEK/PROLOG>PROLOGGRAPH)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PROLOGGRAPHCOMS)

(RPAQQ PROLOGGRAPHCOMS ((FNS ADD-CHILD ADD-CHILD-AND-PUSH-CURR-NODE ADDTOTREE 
                             DELETE-AND-POP-CURR-NODE DELETE-CHILDREN PROLOG-TRACE)))
(DEFINEQ

(ADD-CHILD

  [LAMBDA (LABEL)                                            (* hdj "17-Jul-85 12:37")

    (DECLARE
 (
GLOBALVARS
 PATH))
    (LET ((NODE (
LIST
 LABEL)))
         (
RPLACD
 (
CAR
 PATH)
		 (
CONS
 NODE (
CDAR
 PATH)))
         (push
 PATH NODE])

(ADD-CHILD-AND-PUSH-CURR-NODE

  [LAMBDA (LABEL)                                            (* hdj "17-Jul-85 12:02")

    (DECLARE
 (
GLOBALVARS
 PATH))
    (LET ((NODE (
LIST
 LABEL)))
         (
RPLACD
 (
CAR
 PATH)
		 (
CONS
 NODE (
CDAR
 PATH)))
         (push
 PATH NODE])

(ADDTOTREE

  [LAMBDA (LEVEL CALLTYPE PROCNAME)                          (* hdj "17-Jul-85 12:55")

    (DECLARE
 (
GLOBALVARS
 CALL-GRAPH-WINDOW PATH))
    (LET ((LABEL (
CONS
 PROCNAME LEVEL)))
         (
SELECTQ
 CALLTYPE
		  [call (if
 PATH
			    then
 (ADD-CHILD-AND-PUSH-CURR-NODE
 LABEL)
			  else
 (
SETQ
 PATH (
LIST
 (
LIST
 LABEL]
		  (fail (DELETE-AND-POP-CURR-NODE
 LABEL PATH))
		  (solution (DELETE-CHILDREN
 (pop
 PATH)))
		  [backtrack (if
 PATH
				 then
 (ADD-CHILD-AND-PUSH-CURR-NODE
 LABEL)
			       else
 (
SETQ
 PATH (
LIST
 (
LIST
 LABEL]
		  NIL)
         (
AND
 PATH (
SHOWGRAPH
 (
LAYOUTSEXPR
 (
CAR
 (
LAST
 PATH))
					   (
QUOTE
 VERTICAL))
			      CALL-GRAPH-WINDOW])

(DELETE-AND-POP-CURR-NODE

  [LAMBDA (LABEL)                                            (* hdj "17-Jul-85 12:38")

    (DECLARE
 (
GLOBALVARS
 PATH))
    (
DREMOVE
 (pop
 PATH)
	     (
CAR
 PATH])

(DELETE-CHILDREN

  [LAMBDA (NODE)                                             (* hdj "17-Jul-85 12:01")

    (
RPLACD
 NODE NIL])

(PROLOG-TRACE
  [LAMBDA (LEVEL CALLTYPE PROCNAME)                                        (* hdj 
                                                                           "17-Jul-85 12:55")
    (DECLARE (GLOBALVARS CALL-GRAPH-WINDOW PATH))
    (LET ((LABEL (CONS PROCNAME LEVEL)))
         (SELECTQ CALLTYPE
             (call [if PATH
                       then (ADD-CHILD-AND-PUSH-CURR-NODE LABEL)
                     else (SETQ PATH (LIST (LIST LABEL])
             (fail (DELETE-AND-POP-CURR-NODE LABEL PATH))
             (solution (DELETE-CHILDREN (pop PATH)))
             (backtrack [if PATH
                            then (ADD-CHILD-AND-PUSH-CURR-NODE LABEL)
                          else (SETQ PATH (LIST (LIST LABEL])
             NIL)
         (AND PATH (SHOWGRAPH (LAYOUTSEXPR (CAR (LAST PATH))
                                     (QUOTE VERTICAL))
                          CALL-GRAPH-WINDOW])
)
(PUTPROPS PROLOGGRAPH COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (522 3168 (ADD-CHILD 532 . 815) (ADD-CHILD-AND-PUSH-CURR-NODE 817 . 1119) (ADDTOTREE 
1121 . 1894) (DELETE-AND-POP-CURR-NODE 1896 . 2110) (DELETE-CHILDREN 2112 . 2250) (PROLOG-TRACE 2252
 . 3166)))))
STOP