(DEFUN !TRACE (FN)
  (PROG (DEF)
    (COND ((GET FN 'TRACED) (RETURN ('ALREADY-TRACED))) )
    (SETQ DEF (GET FN 'EXPR)) 
    (COND ((NULL DEF) (RETURN 'NOT-DEFINED)))
    (COND ((NOT (EQ (CAR DEF) 'LAMBDA)) (RETURN 'NOT-LAMBDA)))
    (PUTPROP FN T 'TRACED)
    (PUTPROP FN DEF '!OLDDEF)
    (PUTPROP FN 
	(SUBST FN '?FN 
	(SUBST (CADR DEF) '?ARGS 
	(SUBST (CONS 'LIST (CADR DEF)) '*ARGS (GET '!TRACE '!PATTERN)))) 'EXPR)
    (RETURN 'OK)
  ))

(DEFUN !UNTRACE (FN)
  (PROG (DEF)
    (COND ((NOT (GET FN 'TRACED)) (RETURN 'NOT-TRACED)) )
    (SETQ DEF (GET FN '!OLDDEF)) 
    (PUTPROP FN NIL 'TRACED)
    (REMPROP FN  '!OLDDEF)
    (PUTPROP FN DEF 'EXPR)
    (RETURN 'OK)
  ))

(SETQ !ILEVEL 0)

(DEFPROP !TRACE 
(LAMBDA ?ARGS
  (PROG (!VAL)
    (TERPRI)
    (MARKS !ILEVEL)
    (PRINC '|Entering |) (PRINC '?FN)
    (PROG (ARGL)
	(SETQ ARGL (QUOTE ?ARGS))
	L1
	(COND ((NULL ARGL) (RETURN NIL)))
	(TERPRI)
	(INDENT (PLUS !ILEVEL 2))
	(PRINC (CAR ARGL)) (PRINC '| = |) (PRINC (EVAL (CAR ARGL)))
	(SETQ ARGL (CDR ARGL))
	(GO L1) )
   (SETQ !VAL ((LAMBDA (!ILEVEL) (APPLY (GET '?FN '!OLDDEF) *ARGS)) (ADD1 !ILEVEL)) )
    (TERPRI) 
    (INDENT !ILEVEL)
    (PRINC '|Returning from |) (PRINC '?FN) (PRINC '| with |) (PRINC !VAL)
    (TERPRI)
    (RETURN !VAL)) )

!PATTERN)

(DEFUN INDENT (N)
  (DO ((I 1 (ADD1 I)))((GREATERP I N) NIL) (PRINC '| |)) )

(DEFUN MARKS (N)
  (DO ((I 1 (ADD1 I)))((GREATERP I N) NIL) (PRINC '|>|)) )