(SETQ SETUPLIST  (QUOTE
   ((LOG ((X) ((QUOTIENT 1 X))))
    (SIN ((X) ((COS X))))
    (ARCSIN
     ((X)
      ((QUOTIENT 1
		 (EXPT (DIFFERENCE 1
				   (EXPT X
					 2))
		       (QUOTIENT 1 2))))))
    (ARCCOS
     ((X)
      ((QUOTIENT -1
		 (EXPT (DIFFERENCE 1
				   (EXPT X
					 2))
		       (QUOTIENT 1 2))))))
    (ARCTAN ((X)
	     ((QUOTIENT 1
			(PLUS 1
			      (EXPT X
				    2))))))
    (COS ((X) ((MINUS (SIN X)))))
)))
(SETQ
 GRADLIST
 (MAPCAR
  (FUNCTION (LAMBDA (Z)
   (PROG2  (PUTPROP (CAR Z)
       (LIST(CAADR Z)(NCONS(SIMPLIFYA
           (CAR(CADADR Z))NIL)))
		       (QUOTE GRAD))
  (CAR Z))))
SETUPLIST))
(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO) 
 
(DEFPROP MCONS 
	 (LAMBDA (L) 
		 (COND ((NULL (CDDR L)) (CADR L)) 
		       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L)))))) 
	 MACRO) 
 
 (DEFPROP GRADLIST T SPECIAL)
(DEFPROP SVGRADLIST T SPECIAL)
(DEFPROP ERTALK T SPECIAL)
(DEFPROP FIRSTVAR T SPECIAL)

(DEFPROP ONET T SPECIAL)
(DEFPROP ZEROT T SPECIAL)
(DEFPROP MONET T SPECIAL)
(DEFPROP GRADLIST T SPECIAL)
(DEFPROP FN T SPECIAL)
(DEFPROP E T SPECIAL)
(DEFPROP *X T SPECIAL)


(DEFPROP SUBLIS
 (LAMBDA (A Y)
  (COND ((ATOM Y) (SUB2 A Y))
	((CONS (SUBLIS A (CAR Y))
	       (SUBLIS A (CDR Y))))))
 EXPR)

(DEFPROP SUB2
 (LAMBDA (A Z)
  (COND ((NULL A) Z)
	((EQ (CAAR A) Z) (CDAR A))
	((SUB2 (CDR A) Z))))
 EXPR)

(DEFPROP PAIR
 (LAMBDA (X Y)
  (COND ((NULL X) NIL)
	((CONS (CONS (CAR X) (CAR Y))
	       (PAIR (CDR X) (CDR Y))))))
 EXPR)

(DEFPROP PROP
 (LAMBDA (X Y U)
  (COND ((NULL X) (U))
	((EQ (CAR X) Y) (CDR X))
	((PROP (CDR X) Y U))))
 EXPR) 

(DEFPROP DEPENDS
 (LAMBDA (E X)
  (COND ((EQ E X) T)
	((TALKP E) NIL)
	((ATOM E)
	 (MEMBER X
		 (GET E (QUOTE DEPENDS))))
	((OR (DEPENDS (CAR E) X)
	      (DEPENDS (CDR E) X)))))
 EXPR)



(DEFPROP SDIFF
 (LAMBDA (E *X)
  (COND
   ((EQ E *X) ONET)
   ((ATOM E)
    (COND ((DEPENDS E *X)
	   (LIST (QUOTE DERIV) E *X ONET))
	  (T ZEROT)))
   ((TALKP E) ZEROT)
   ((NOT (DEPENDS E *X)) ZEROT)
   ((GET (CAR E) (QUOTE DIFFFN))
    (APPLY (GET (CAR E) (QUOTE DIFFFN))
	   (LIST E *X)))
   (T
    (SIMPLUS
     (CONS
      (QUOTE PLUS)
      (MAPCAR
       (FUNCTION
	(LAMBDA (K)
	 (SIMPTIMES (LIST (QUOTE TIMES)
			  (SIMPLIFYA(CAR K)NIL)
			  (CDR K))
		    ONET
		    T)))
       (PAIR
	((LAMBDA (GRAD)
	  (COND
	   ((NOT
	     (EQUAL (LENGTH (CDR E))
		    (LENGTH (CAR GRAD))))
	    (ERLIST
	     (APPEND (QUOTE (WRONG NUMBER
				   OF
				   ARGS
				   FOR))
		     (LIST (CAR E)))))
	   (T (SUBLIS (PAIR (CAR GRAD)
			    (CDR E))
		      (CADR GRAD)))))
	 ((LAMBDA (L)
	   (COND
	    (L L)
	    (T
	     (DIFFERROR
	      (CONS (CAR E)
		    (LENGTH (CDR E)))))))
	  (GET (CAR E) (QUOTE GRAD))))
	(MAPCAR
	 
	 (FUNCTION (LAMBDA (J)
			   (SDIFF J
				  *X)))
(CDR E)))))
     ONET
     T))))
 EXPR)

(DEFPROP PUMP
 (LAMBDA NIL
  (MAPCAR
   (FUNCTION
    (LAMBDA (J)
     ((LAMBDA (K)
       (RPLACA
	(CDAR K)
	(MAPCAR
	 
	 (FUNCTION
	  (LAMBDA (L) (SIMPLIFYA L F)))
(CADAR K))))
      (PROP
       J
       (QUOTE GRAD)
       (FUNCTION
	(LAMBDA NIL
	 (ERLIST (QUOTE(SVGRADLIST ERROR)))))))))
   SVGRADLIST))
 EXPR)

(SETQ SVGRADLIST NIL)

(DEFPROP DIFFPLUS
 (LAMBDA (E *X)
  (SIMPLUS
   (CONS
    (QUOTE PLUS)
    (MAPCAR (FUNCTION (LAMBDA (J)
			      (SDIFF J *X)))
	    (CDDR E)))
   ONET
   T))
 EXPR)

(DEFPROP DIFFTIMES
 (LAMBDA (E X) (SIMPLUS (CONS (QUOTE PLUS)
			      (SDT (CDDR E)
				   (CADR E)
				   X))
			ONET
			T))
 EXPR)

(DEFPROP SDT
 (LAMBDA (L C X)
  (PROG (SP LEFT RITE OUT)
	(SETQ SP (CAR L))
	(SETQ RITE (CDR L))
   LOOP	(SETQ
	 OUT
	 (NCONC
	  OUT
	  (LIST
	   (SIMPTIMES
	    (CONS
	     (QUOTE TIMES)
	     (CONS C (CONS (SDIFF SP X)
			   (APPEND LEFT
				   RITE))))
	    ONET
	    T))))
	(COND ((NULL RITE) (RETURN OUT)))
	(SETQ LEFT (NCONC LEFT (LIST SP)))
	(SETQ SP (CAR RITE))
	(SETQ RITE (CDR RITE))
	(GO LOOP)))
 EXPR)

(DEFPROP DIFFEXPT
 (LAMBDA (E X)
  (COND
   ((TALKP (CADDR E))
    (SIMPTIMES
     (LIST (QUOTE TIMES)
	   (CADDR E)
	   (SIMPEXPT (LIST (QUOTE EXPT)
			   (CADR E)
			   (ADDK (CADDR E)
				 MONET))
		     ONET
		     T)
	   (SDIFF (CADR E) X))
     ONET
     T))
   (T
    (SIMPLUS
     (LIST
      (QUOTE PLUS)
      (SIMPTIMES
       (LIST
	(QUOTE TIMES)
	(SIMPEXPT
	 (LIST (QUOTE EXPT)
	       (CADR E)
	       (SIMPLUS (LIST (QUOTE PLUS)
			      (CADDR E)
			      MONET)
			ONET
			T))
	 ONET
	 T)
	(CADDR E)
	(SDIFF (CADR E) X))
       ONET
       T)
      (SIMPTIMES
       (LIST (QUOTE TIMES)
	     (SIMPEXPT (LIST (QUOTE EXPT)
			     (CADR E)
			     (CADDR E))
		       ONET
		       T)
	     (SIMPLN (LIST (QUOTE LOG)
			   (CADR E))
		     ONET
		     T)
	     (SDIFF (CADDR E) X))
       ONET
       T))
     ONET
     T))))
 EXPR)

(DEFPROP DIFFEQUAL
	 (LAMBDA (E X)
		 (LIST (CAR E)
		       (SDIFF (CADR E) X)
		       (SDIFF (CADDR E) X)))
	 EXPR)


(DEFPROP PLUS DIFFPLUS DIFFFN)

(DEFPROP TIMES DIFFTIMES DIFFFN)

(DEFPROP EXPT DIFFEXPT DIFFFN)

(DEFPROP EQUAL DIFFEQUAL DIFFFN)

(QUOTE (FILE DIFR))

 (DEFPROP A T SPECIAL)
(DEFPROP B T SPECIAL)
(DEFPROP D T SPECIAL)
(DEFPROP SP T SPECIAL)
(DEFPROP LP T SPECIAL)
(DEFPROP RP T SPECIAL)
(DEFPROP CO T SPECIAL)


(DEFPROP DIFFERROR
 (LAMBDA (G)
  (PROG
   (A N B RES GR DR C D)
   (SETQ A (CAR G))
   (SETQ N (CDR G))
   (SETQ B (MAKEVAR1 N))
   (SETQ C B)
ASKA
   (PRINLIST (APPEND (QUOTE (NEED GRADIENT
				  OF))
		     (LIST A)))
(PRINC (QUOTE #))
   (SETQ RES (ERRSET(PRE)NIL))
(COND((NOT RES)(GO ASKA)))
(SETQ RES(CAR RES))
   (COND
    ((EQUAL RES (QUOTE ASK)) (GO ASK))
    ((EQUAL RES (QUOTE ALLFORMAL))
     (GO ALLFORM))
    ((EQUAL RES (QUOTE USEDEF)) (GO USEDF))
    (T
     (PRINLIST
      (QUOTE (
			RESPONSES
			ARE
			ASK
			USEDEF
			AND
			ALLFORMAL)))))
   (GO ASKA)
END(SETQ
    GR
    (MAPCAR
     (FUNCTION (LAMBDA (X)
		       (SIMPLIFYA X NIL)))
     GR))

   (NCONC(COND
     ((EVAL(CONS(QUOTE AND)(MAPCAR(FUNCTION ONEVAR)GR)))GRADLIST)
     (T SVGRADLIST)   )(LIST A))
   (SETQ GR (CONS B (LIST GR)))
   (PUTPROP A GR (QUOTE GRAD))
  (TERPRI)
   (RETURN GR)
ALLFORM
   (SETQ
    GR
    (APPEND
     GR
     (MAPCAR
      (FUNCTION
       (LAMBDA (X)
	(CONS
	 (READLIST
	  (APPEND (QUOTE (D))
		  (CDR (EXPLODE X))
		  (EXPLODE A)))
	 B)))
      C)))
   (GO END)
ASK(TERPRI)
   (PRINC (QUOTE CONSIDER))
   (PRINC SP)
   (PRINFUN A B)
ASK1
   (COND ((NULL C) (GO END)))
   (CHARYBDIS (LIST (QUOTE EQUAL)
		    (LIST (QUOTE DERIV)
			  (CONS A B)
			  (CAR C)
			  1)
		    SP)
	      1
	      (LINELENGTH NIL))
(PRINC (QUOTE #))
   (SETQ RES
	 (ERRSET (UNQUOTE (PRE)) ERTALK))
     (TERPRI)
   (COND ((NULL RES) (GO ASK1)))
   (SETQ RES (CAR RES))
   (COND ((EQUAL RES (QUOTE FORMAL))
	  (GO FORM))
	 ((EQUAL RES (QUOTE ALLFORMAL))
	  (GO ALLFORM))
	 (T (GO LOOP1)))
LOOP2
   (SETQ C (CDR C))
   (GO ASK1)
FORM
   (COND ((NULL C) (GO END)))
   (SETQ
    DR
    (CONS
     (READLIST
      (APPEND (QUOTE (D))
	      (CDR (EXPLODE (CAR C)))
	      (EXPLODE A)))
     B))
   (SETQ GR (APPEND GR (LIST DR)))
   (GO LOOP2)
LOOP1
   (SETQ GR (APPEND GR (LIST RES)))
   (GO LOOP2)
USEDF
   (SETQ D (MGET A))
   (COND
    ((NOT (EQUAL (CAR D) (QUOTE LAMBDA)))
     (ERLIST (CONS A (QUOTE (IS NOT
				DEFINED)))))
    ((NOT (EQUAL N (LENGTH (CADR D))))
     (ERLIST (QUOTE (WRONG NUMBER
			   OF
			   ARGUMENTS)))))
L1 (SETQ B (CADR D))
   (SETQ D (CADDR D))
   (SETQ
    GR
    (MAPCAR
     (FUNCTION
      (LAMBDA (X)
       (EVAL (CONS (QUOTE DERIV)
		   (CONS D (LIST X))))))
     B))
   (GO END)))
 EXPR)

(DEFPROP PRINFUN
 (LAMBDA (FUN ARGS)
	 (PROG NIL
	       (PRINC FUN)
	       (PRINC LP)
	  LOOP (COND ((NULL (CDR ARGS))
		      (GO END)))
	       (PRINC (CAR ARGS))
	       (PRINC CO)
	       (SETQ ARGS (CDR ARGS))
	       (GO LOOP)
	  END  (PRINC (CAR ARGS))
	       (PRINC RP)
	       (RETURN (TERPRI))))
 EXPR)

(DEFPROP MAKEVAR
 (LAMBDA (N) (READLIST (CONS (QUOTE X)
			     (EXPLODE N))))
 EXPR)

(DEFPROP MAKEVAR1
 (LAMBDA (N)
  (PROG (J ARG)
	(SETQ J 1)
   LOOP	(SETQ ARG
	      (APPEND ARG
		      (LIST (MAKEVAR J))))
	(SETQ J (ADD1 J))
	(COND ((GREATERP J N) (RETURN ARG)))
	(GO LOOP)))
 EXPR)

 (DEFPROP ONEVAR(LAMBDA(X)(PROG
             (FIRSTVAR)(RETURN(COND((ONEVAR1 X)T)(T NIL)))))EXPR)
(DEFPROP ONEVAR1(LAMBDA(X)(COND
   ((ATOM X)(COND
     ((NULL FIRSTVAR)(SETQ FIRSTVAR  X))
     ((EQ X FIRSTVAR))
   )        )

   ((TALKP X)T)
   ((ONEVAR2(CDR X)))
))EXPR)

(DEFPROP ONEVAR2(LAMBDA(X)(COND
   ((NULL X)T)
   ((ONEVAR1(CAR X))(ONEVAR2(CDR X)))
   (NIL)