Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0039/mlab37.l
There are 2 other files named mlab37.l in the archive. Click here to see a list.
(DEFPROP PT T SPECIAL)
(DEFPROP SP T SPECIAL)

(DEFPROP SWITCH T SPECIAL)
(DEFPROP MYTURN T SPECIAL)

(DEFPROP TALLPAR T SPECIAL)
(DEFPROP COLON T SPECIAL)
(DEFPROP PERIOD T SPECIAL)
(DEFPROP SLASH T SPECIAL)

(DEFPROP BLANK T SPECIAL)
(DEFPROP ALLSTAR T SPECIAL)

(DEFPROP WARNING T SPECIAL)
(DEFPROP ERTALK T SPECIAL)
(DEFPROP SIMP T SPECIAL)

(DEFPROP EXPRLIST T SPECIAL)
(DEFPROP EQUATLIST T SPECIAL)
(DEFPROP FUNLIST T SPECIAL)
(DEFPROP MLABHIST T SPECIAL)
(DEFPROP DEPENDLIST T SPECIAL)

(DEFPROP *X T SPECIAL)

(DEFPROP PRED T SPECIAL)

(DEFPROP OLDSYS T SPECIAL)

(DEFPROP GRADLIST T SPECIAL)
(DEFPROP EXPR T SPECIAL)

(DEFPROP ORDL T SPECIAL)
(DEFPROP EXPOP T SPECIAL)
(DEFPROP EXPON T SPECIAL)
(DEFPROP ORDLA T SPECIAL)
(DEFPROP ORDLB T SPECIAL)
(DEFPROP ONET T SPECIAL)
(DEFPROP ZEROT T SPECIAL)
(DEFPROP MONET T SPECIAL)
(DEFPROP **3 T SPECIAL)
(QUOTE (FILE PT))

(DEFPROP LEAD
	 (LAMBDA (Z) (COND ((ATOM Z) NIL)
			   (T (CAR Z))))
	 EXPR)

(DEFPROP SPT
 (LAMBDA (X)
  (COND
   ((ATOM X) X)
   (T
    ((LAMBDA (J)
      (COND ((NOT (OR (EQ (CAR X)
			  (QUOTE PLUS))
		      (EQ (CAR X)
			  (QUOTE TIMES))))
	     (CONS (CAR X) J))
	    (T (CONS (CAR X)
		     (POPUP (CAR X) J)))))
     (MAPCAR  (FUNCTION SPT)(CDR X))))))
 EXPR)

(DEFPROP POPUP
 (LAMBDA (OP LIST)
  (COND ((NULL LIST) NIL)
	((OR (ATOM (CAR LIST))
	     (NOT (EQ (CAAR LIST) OP)))
	 (CONS (CAR LIST)
	       (POPUP OP (CDR LIST))))
	(T (APPEND (CDAR LIST)
		   (POPUP OP (CDR LIST))))))
 EXPR)

(DEFPROP OPP
 (LAMBDA (X) (MEMBER X
		     (QUOTE (PLUS TIMES
				  DIFFERENCE
				  MINUS
				  QUOTIENT
				  EXPT
				  EQUAL))))
 EXPR)
(QUOTE (FILE M1))

(DEFPROP UNQUOTE
 (LAMBDA (*X)
  (COND
   ((ATOM *X)*X)
   ((EQ(CAR *X)(QUOTE QUOTE))(CADR *X))
   ((GET (CAR *X) (QUOTE TOPCOM)) (EVAL *X))
   ((EQ (CAR *X) (QUOTE SETQ))
    (MLABSET (UNQUOTE (CADR *X))
	     (UNQUOTE (CADDR *X))
		T))
   ((EQ (CAR *X) (QUOTE UNQUOTE))
(UNQUOTE    (MGET (UNQUOTE (CADR *X)))))
   ((EQ (CAR *X) (QUOTE DERIV))
    (CONS
     (QUOTE DERIV)
     (DERIVUNQUOTE
      (MAPCAR (FUNCTION UNQUOTE) (CDR *X))
      NIL)))
   ((AND (NOT (ATOM (CAR *X)))
	 (EQ (CAAR *X) (QUOTE UNQUOTE)))
    (COND
     ((GET (CADAR *X) (QUOTE INTCOM))
      (EVAL (CONS (CADAR *X) (CDR *X))))
     ((NOT
       (EQ (CAR (MGET (UNQUOTE (CADAR *X))))
	   (QUOTE LAMBDA)))
      (ERLIST
       (APPEND
	(QUOTE (NO FUNCTION NAMED))
	(LIST (UNQUOTE (CADAR *X))))))
     (T  (UNQUOTE
      (FUNEVAL
       (UNQUOTE (CADAR *X))
       (MGET (UNQUOTE (CADAR *X)))
       (MAPCAR (FUNCTION UNQUOTE)
		 (CDR *X)))))))
       ((EQ (CAR *X) (QUOTE MINUS))
	(MINUSHANDLE *X))
       ((AND (OR (EQ (CAR *X) (QUOTE PLUS))
		 (EQ (CAR *X)
		     (QUOTE TIMES)))
	     (CDDDR *X))
	(UNQUOTE (LIST (CAR *X)
		       (CADR *X)
		       (CONS (CAR *X)
			     (CDDR *X)))))
((AND(EQ(CAR *X)(QUOTE EQUAL))(CDDDR *X))
 (ERLIST(QUOTE(CAN ONLY EQUATE TWO EXPRESSIONS))))
       ((OPP (CAR *X))
	((LAMBDA (*1 *2 *3)
	  (COND
	   ((EQ *1 (QUOTE EQUAL))
	    (COND
	     ((OR (EQ (LEAD *2)
		      (QUOTE EQUAL))
		  (EQ (LEAD *3)
		      (QUOTE EQUAL)))
	      (ERLIST
	       (QUOTE (CANNOT EQUATE
			      EQUATIONS))))
	     ((OR (EQ (LEAD *2)
		      (QUOTE LAMBDA))
		  (EQ (LEAD *3)
		      (QUOTE LAMBDA)))
	      (ERLIST
	       (QUOTE (CANNOT EQUATE
			      FUNCTIONS))))
	     (T (LIST *1 *2 *3))))
	   (T (OPHANDLE *1 *2 *3))))
	 (CAR *X)
	 (UNQUOTE (CADR *X))
	 (UNQUOTE (CADDR *X))))
       (T
	((LAMBDA (K)
	  (COND
	   ((EVAL
	     (CONS
	      (QUOTE OR)
	      (MAPLIST
	       (FUNCTION
		(LAMBDA (EACH)
		 (OR (EQ (LEAD (CAR EACH))
			 (QUOTE EQUAL))
		     (EQ (LEAD (CAR EACH))
			 (QUOTE LAMBDA)))))
	       K)))
	    (ERLIST
	     (QUOTE (ARGUMENTS OF
			       FUNCTIONS
			       CANNOT
			       BE
			       FUNCTIONS
			       OR
			       EQUATIONS))))
	   (T (CONS (CAR *X) K))))
	 (MAPCAR (FUNCTION UNQUOTE)
		 (CDR *X))))))
 EXPR)

(DEFPROP DERIVUNQUOTE
 (LAMBDA (X FLAG)
  (COND ((OR (NULL X) (NULL (CDR X)))
	 (BUMDERIV))
	((NULL (CDDR X))
	 (COND ((NOT (LATOM (CADR X)))
		(BUMDERIV))
	       (T (LIST (CAR X)
			(CADR X)
			1))))
	(T (CONS (CAR X)
		 (DERIVCHECK (CDR X)
			     FLAG)))))
 EXPR)

(DEFPROP DERIVCHECK
 (LAMBDA (X FLAG)
  (COND
   ((NULL X) NIL)
   ((OR (NOT (LATOM (CAR X)))
	(NULL (CDR X))
	(COND (FLAG (NOT (NONNEG (CADR X))))
	      (T NIL)))
    (BUMDERIV))
   (T (CONS (CAR X)
	    (CONS (CADR X)
		  (DERIVCHECK (CDDR X)
			      FLAG))))))
 EXPR)

(DEFPROP BUMDERIV
 (LAMBDA NIL (ERLIST (QUOTE (WRONG FORM
				   FOR
				   DERIV))))
 EXPR)

(DEFPROP MLABSET
 (LAMBDA (NAME VALUE IND)
  (PROG NIL
	(COND ((NOT (ATOM NAME)) (GO FN)))
	(COND
	 ((NUMBERP NAME)
	  (SETQ NAME
		(ASK1 (QUOTE (NAME))
		      (FUNCTION LATOM)))))
	(COND
	 ((AND WARNING
	       (NOT (EQ NAME (QUOTE WS)))
	       (GET NAME (QUOTE MLAB)))
	  (PROG NIL
		(PRINLIST
		 (APPEND
		  (QUOTE (ALREADY ONE))
		  (CONS
		   NAME
		   (CONS
		    PT
		    (QUOTE (WANT TO
				 LOSE
				 IT?))))))
		(COND
		 ((NOT (YORN))
		  (SETQ
		   NAME
		   (ASK1
		    (QUOTE (NAME))
		    (FUNCTION LATOM))))))))
	(PUTPROP
	 NAME
	 (COND
	  ((AND SIMP IND)
	   (CLEAN
	    (UNKLUDGE
	     (SIMPLIFYA (KLUDGE VALUE)
			NIL))))
	  (IND (SPT (REMDIF VALUE)))
	  (VALUE))
	 (QUOTE MLAB))
	(COND
	 ((AND(NOT(ATOM VALUE))(EQ (CAR VALUE) (QUOTE EQUAL)))
	  (PROG NIL
		(SETQ EQUATLIST
		      (PASTE NAME
			     EQUATLIST))
		(SETQ EXPRLIST
		      (WIPE NAME EXPRLIST))
		(SETQ FUNLIST
		      (WIPE NAME FUNLIST))))
	 ((AND(NOT(ATOM VALUE))(EQ (CAR VALUE) (QUOTE LAMBDA)))
	  (PROG NIL
		(SETQ FUNLIST
		      (PASTE NAME FUNLIST))
		(SETQ EXPRLIST
		      (WIPE NAME EXPRLIST))
		(SETQ EQUATLIST
		      (WIPE NAME
			    EQUATLIST))))
	 (T (PROG NIL
		  (SETQ EXPRLIST
			(PASTE NAME
			       EXPRLIST))
		  (SETQ EQUATLIST
			(WIPE NAME
			      EQUATLIST))
		  (SETQ FUNLIST
			(WIPE NAME
			      FUNLIST)))))
	(RETURN (GET NAME (QUOTE MLAB)))
   FN	(COND
	 ((NOT (FUNFORMP NAME))
	  (ERLIST
	   (QUOTE (IMPROPER FORM
			    FOR
			    DEFINING
			    A
			    FUNCTION))))
	 ((AND(NOT(ATOM VALUE))(EQ (CAR VALUE) (QUOTE LAMBDA)))
	  (ERLIST
	   (QUOTE (CANNOT ASSIGN
			  A
			  FUNCTION
			  AS
			  THE
			  VALUE
			  OF
			  A
			  FUNCTION))))
	 ((AND(NOT(ATOM VALUE))(EQ (CAR VALUE) (QUOTE EQUAL)))
	  (ERLIST
	   (QUOTE (CANNOT ASSIGN
			  AN
			  EQUATION
			  AS
			  THE
			  VALUE
			  OF
			  A
			  FUNCTION))))
	 ((AND WARNING
	       (NOT (EQ (CAR NAME)
			(QUOTE WS)))
	       (GET (CAR NAME)
		    (QUOTE MLAB)))
	  (PROG NIL
		(PRINLIST
		 (APPEND
		  (QUOTE (ALREADY ONE))
		  (CONS
		   (CAR NAME)
		   (CONS
		    PT
		    (QUOTE (WANT TO
				 LOSE
				 IT?))))))
		(COND
		 ((NOT (YORN))
		  (SETQ
		   NAME
		   (CONS
		    (ASK1 (QUOTE (NAME))
			  (FUNCTION LATOM))
		    (CDR NAME))))))))
	(PUTPROP
	 (CAR NAME)
	 (LIST
	  (QUOTE LAMBDA)
	  (CDR NAME)
	  (COND
	   (SIMP
	    (CLEAN
	     (UNKLUDGE
	      (SIMPLIFYA (KLUDGE VALUE)
			 NIL))))
	   (T (SPT (REMDIF VALUE)))))
	 (QUOTE MLAB))
	(SETQ FUNLIST
	      (PASTE (CAR NAME) FUNLIST))
	(SETQ EXPRLIST
	      (WIPE (CAR NAME) EXPRLIST))
	(SETQ EQUATLIST
	      (WIPE (CAR NAME) EQUATLIST))
	(RETURN (GET (CAR NAME)
		     (QUOTE MLAB)))))
 EXPR)

(DEFPROP YORN
 (LAMBDA NIL
  (PROG (REPLY)
   LOOP(PRINC(QUOTE #))
    (SETQ REPLY(ERRSET(PRE)NIL))
   (COND((NULL REPLY)(GO ECH)))
   (SETQ REPLY(CAR REPLY))
	(COND ((EQ REPLY (QUOTE YES))
	       (RETURN T))
	      ((EQ REPLY (QUOTE NO))
	       (RETURN NIL)))
ECH     (PRINLIST (QUOTE (ANSWER YES
				 OR
				 NO)))
	(GO LOOP)))
 EXPR)

(DEFPROP MGET
 (LAMBDA (NAME)
  (COND
   ((NOT (LATOM NAME))
    (ERLIST (QUOTE (ONLY ATOMS
			 HAVE
			 VALUES))))
   ((GET NAME (QUOTE MLAB))
    (GET NAME (QUOTE MLAB)))
   (T (ERLIST (APPEND (QUOTE (CANNOT FIND))
		      (LIST NAME))))))
 EXPR)

(DEFPROP FUNFORMP
 (LAMBDA (X) (COND ((ATOM X) NIL)
		   ((LATOM (CAR X))
		    (OR (NULL (CDR X))
			(FUNFORMP (CDR X))))
		   (T NIL)))
 EXPR)

(DEFPROP FUNEVAL
 (LAMBDA (NAME LAMDEF ARGLIST)
  (COND
   ((NOT (EQUAL (LENGTH (CADR LAMDEF))
		(LENGTH ARGLIST)))
    (ERLIST
     (APPEND
      (QUOTE (YOU ARE GIVING ME))
      (CONS
       (LENGTH ARGLIST)
       (APPEND
	(QUOTE (ARGUMENTS FOR))
	(CONS
	 NAME
	 (APPEND
	  (QUOTE (WHICH HAS))
	  (LIST (LENGTH (CADR LAMDEF))
		(QUOTE ARGUMENTS)))))))))
   ((EVAL
     (CONS
      (QUOTE OR)
      (MAPLIST
       (FUNCTION
	(LAMBDA (J)
		(OR (EQ (LEAD(CAR J))
			(QUOTE LAMBDA))
		    (EQ (LEAD(CAR J))
			(QUOTE EQUAL)))))
       ARGLIST)))
    (ERLIST (QUOTE (ARGUMENTS OF
			      A
			      FUNCTION
			      CANNOT
			      BE
			      FUNCTIONS
			      OR
			      EQUATIONS))))
   (T (SUBLIS (PAIR (CADR LAMDEF) ARGLIST)
	      (CADDR LAMDEF)))))
 EXPR)

(DEFPROP OPHANDLE
 (LAMBDA (*1 *2 *3)
	 (COND ((OR (EQ (LEAD *2)
			(QUOTE LAMBDA))
		    (EQ (LEAD *3)
			(QUOTE LAMBDA)))
		(OPFUNHANDLE *1 *2 *3))
	       ((OR (EQ (LEAD *2)
			(QUOTE EQUAL))
		    (EQ (LEAD *3)
			(QUOTE EQUAL)))
		(OPEQUATHANDLE *1 *2 *3))
	       (T (LIST *1 *2 *3))))
 EXPR)

(DEFPROP OPFUNHANDLE
 (LAMBDA (*1 *2 **3)
  (COND
   ((NOT (AND (EQ (LEAD *2) (QUOTE LAMBDA))
	      (EQ (LEAD **3) (QUOTE LAMBDA))))
    (ERLIST
     (APPEND
      (QUOTE (CAN ONLY))
      (CONS
       (OPVERB *1)
       (QUOTE (FUNCTIONS AND FUNCTIONS))))))
   ((NOT (EQUAL (LENGTH (CADR *2))
		(LENGTH (CADR **3))))
    (ERLIST
     (CONS
      (QUOTE CANNOT)
      (CONS
       (OPVERB *1)
       (APPEND
	(QUOTE (A FUNCTION OF))
	(CONS
	 (LENGTH (CADR *2))
	 (APPEND
	  (QUOTE (ARGUMENTS AND
			    A
			    FUNCTION
			    OF))
	  (CONS (LENGTH (CADR **3))
		(QUOTE (ARGUMENTS))))))))))
(T((LAMBDA(DUMLIST)(LIST(Q LAMBDA)DUMLIST
          (LIST *1
            (SUBLIS(PAIR(CADR *2)DUMLIST)(CADDR *2))
            (SUBLIS(PAIR(CADR **3)DUMLIST)(CADDR **3))
   )))
   (MAPCAR(FUNCTION(LAMBDA(J)(COND
              ((AND(INN J(CADDR **3))(NOT(MEMBER J(CADR **3))))(MLGEN))
              (T J)
          )))
          (CADR *2)
) ))
)) EXPR)

(DEFPROP OPVERB
 (LAMBDA (X)
(CDR (ASSOC X (QUOTE ((PLUS.ADD)
		(TIMES.MULTIPLY)
		(DIFFERENCE.SUBTRACT)
		(QUOTIENT.DIVIDE)
		(EXPT.RAISE))))))
 EXPR)

(DEFPROP OPEQUATHANDLE
 (LAMBDA (*1 *2 *3)
  (COND (EQ (LEAD *2) (QUOTE LAMBDA))
	(EQ (LEAD *3) (QUOTE LAMBDA)))
    (ERLIST (QUOTE (CANNOT EQUATE
			   FUNCTIONS))))
   ((AND (EQ (LEAD *2) (QUOTE EQUAL))
	 (EQ (LEAD *3) (QUOTE EQUAL)))
    (LIST (QUOTE EQUAL)
	  (LIST *1 (CADR *2) (CADR *3))
	  (LIST *1 (CADDR *2) (CADDR *3))))
   ((EQ (LEAD *2) (QUOTE EQUAL))
    (LIST (QUOTE EQUAL)
	  (LIST *1 (CADR *2) *3)
	  (LIST *1 (CADDR *2) *3)))
   (T (LIST (QUOTE EQUAL)
	    (LIST *1 *2 (CADR *3))
	    (LIST *1 *2 (CADDR *3))))))
 EXPR)

(DEFPROP MINUSHANDLE
 (LAMBDA (X)
  ((LAMBDA (Y)
	   (COND ((EQ (LEAD Y)
		      (QUOTE LAMBDA))
		  (LIST (QUOTE LAMBDA)
			(CADR Y)
			(LIST (QUOTE MINUS)
			      (CADDR Y))))
		 ((EQ (LEAD Y) (QUOTE EQUAL))
		  (LIST (QUOTE EQUAL)
			(LIST (QUOTE MINUS)
			      (CADR Y))
			(LIST (QUOTE MINUS)
			      (CADDR Y))))
		 (T (LIST (QUOTE MINUS)
			  Y))))
   (UNQUOTE (CADR X))))
 EXPR)
(QUOTE (FILE M2))

(DEFPROP INVENTORY
 (LAMBDA (X Y)
  (PROG NIL
	(TERPRI)
	(COND
	 ((NULL X)
	  (COND
	   ((AND (NULL EXPRLIST)
		 (NULL EQUATLIST)
		 (NULL FUNLIST))
	    (PRINC (QUOTE EMPTY)))
	   (T
	    (PROG NIL
		  (REPORT
		   (QUOTE EXPRESSIONS)
		   NIL)
		  (REPORT (QUOTE EQUATIONS)
			  NIL)
		  (REPORT (QUOTE FUNCTIONS)
			  NIL))))))
   LOOP	(COND ((NULL X) (RETURN NIL)))
	(REPORT (CAR X) T)
	(SETQ X (CDR X))
	(GO LOOP)))
 FEXPR)

(DEFPROP REPORT
 (LAMBDA (X IND)
  (PROG (L)
	(SETQ L (LISTGET X))
	(COND ((NULL L) (GO N)))
A       (PRINLIST(MCONS X COLON 
                         (COND((NULL L)(QUOTE(NONE)))(T L))))
	(RETURN (TERPRI))
   N	(COND (IND (GO A))
	      (T (RETURN NIL)))))
 EXPR)

(DEFPROP LISTGET
 (LAMBDA (X)
  (COND
   ((EQ X (QUOTE EXPRESSIONS)) EXPRLIST)
   ((EQ X (QUOTE EQUATIONS)) EQUATLIST)
   ((EQ X (QUOTE FUNCTIONS)) FUNLIST)
   (T (ERLIST (QUOTE (ONLY WORDS
			   THAT
			   MAY
			   FOLLOW
			   INVENTORY
			   ARE
			   EXPRESSIONS
			   EQUATIONS
			   AND
			   FUNCTIONS))))))
 EXPR)

(DEFPROP PASTE
	 (LAMBDA (X L)
		 (COND ((NOT (MEMBER X L))
			(CONS X L))
		       (T L)))
	 EXPR)

(DEFPROP WIPE
 (LAMBDA (X L)
	 (COND ((NULL L) NIL)
	       ((EQ (CAR L) X) (CDR L))
	       (T (CONS (CAR L)
			(WIPE X (CDR L))))))
 EXPR)

(DEFPROP SAVE
 (LAMBDA (X Y)
  (COND
   ((OR (NULL X)(CDR X) (NOT (LATOM (CAR X))))
    (ERLIST(QUOTE(WRONG FORM FOR SAVE))))
   (T (PROG2 (MLABSET (CAR X)
		      (MGET (QUOTE WS))
			NIL)
	     NIL))))
 FEXPR)


(DEFPROP ASK1
 (LAMBDA (NAME PRED)
  (PROG (REPLY)
   LOOP	(PRINLIST (APPEND (QUOTE (GIVE ME
				       A))
			  NAME))
        (PRINC(QUOTE #))
	(SETQ REPLY(ERRSET(PRE)NIL))
         (COND((NULL REPLY)(GO LOOP)))
         (SETQ REPLY(CAR REPLY))
	(COND ((NOT (PRED REPLY))
	       (GO LOOP)))
	(RETURN REPLY)))
 EXPR)

(DEFPROP REPEAT
	 (LAMBDA (X Y)
		 (BOOKKEEP X
			   (QUOTE REPEAT)))
	 FEXPR)

(DEFPROP RESTORE
	 (LAMBDA (X Y)
		 (BOOKKEEP X
			   (QUOTE RESTORE)))
	 FEXPR)

(DEFPROP BOOKKEEP
 (LAMBDA (*X COM)
  (PROG (N IT PAST AINT)
      	(COND ((NULL *X)
	       (SETQ *X (QUOTE (1)))))
   TOP  (COND ((NONNEG (CAR *X))
	       (GO NUMBER))
	      ((NOT (ATOMLIST *X))
	       (ERLIST(APPEND(QUOTE(ILLEGAL FORM FOR))(LIST COM)))))
   LOOP	(COND
	 ((NULL *X)
	  (RETURN
	   (COND
	    (AINT
	     (ERLIST
	      (APPEND (QUOTE (CANNOT FIND))
		      AINT)))
	    (T NIL)))))
	(COND ((GET (CAR *X) (QUOTE MLAB))
	       (SETQ IT (GET (CAR *X)
			     (QUOTE MLAB))))
	      (T (SETQ AINT (CONS (CAR *X)
				  AINT))))
	(COND
	 ((EQ COM (QUOTE RESTORE))
	  (COND
	   ((GET (CAR *X) (QUOTE MLAB))
	    (RETURN
	     (PROG NIL
		   (SETQ MLABHIST
			 (CONS IT MLABHIST))
		   (MLABSET (QUOTE WS)
			    IT NIL))))
	   (T
	    (ERLIST
	     (APPEND (QUOTE (CANNOT FIND))
		     AINT)))))
	 ((AND (EQ COM (QUOTE REPEAT))
	       (GET (CAR *X) (QUOTE MLAB)))
	  (REPEAT1
	   ((LAMBDA (W)
	     (COND ((EQ (LEAD W)
			(QUOTE LAMBDA))
		    (LIST (QUOTE SETQ)
			  (CONS (CAR *X)
				(CADR W))
			  (CADDR W)))
		   (T (LIST (QUOTE SETQ)
			    (CAR *X)
			    W))))
	    (GET (CAR *X) (QUOTE MLAB)))))
	 ((AND (EQ COM (QUOTE KILL))
	       (GET (CAR *X) (QUOTE MLAB)))
	  (PROG NIL
		(REMPROP (CAR *X)
			 (QUOTE MLAB))
		(SETQ EXPRLIST
		      (WIPE (CAR *X)
			    EXPRLIST))
		(SETQ EQUATLIST
		      (WIPE (CAR *X)
			    EQUATLIST))
		(SETQ FUNLIST
		      (WIPE (CAR *X)
			    FUNLIST)))))
	(SETQ *X (CDR *X))
	(GO LOOP)
   ASK   NUMBER
	(SETQ N (CAR *X))
	(COND
	 ((LESSP (LENGTH MLABHIST) N)
	  (ERLIST
	   (CONS
	    (QUOTE ONLY)
	    (CONS
	     (LENGTH MLABHIST)
	     (QUOTE (THINGS IN
			    HISTORY
			    OF
			    WORKSPACE))))))
	 ((ZEROP N) (RETURN NIL)))
	(SETQ PAST MLABHIST)
   NUMLOOP
	(COND ((ONEP N) (GO OUT)))
	(SETQ PAST (CDR PAST))
	(SETQ N (SUB1 N))
	(GO NUMLOOP)
   OUT	(COND
	 ((EQ COM (QUOTE REPEAT))
	  (REPEAT1
	   ((LAMBDA (WW)
	     (COND
	      ((EQ (LEAD WW) (QUOTE LAMBDA))
	       (LIST (QUOTE SETQ)
		     (CONS (QUOTE FUNCTION)
			   (CADR WW))
		     (CADDR WW)))
((EQ(LEAD WW)(Q MATRIX))(LIST(Q SETQ)(Q NONAME) WW))
	      (T WW)))
	    (CAR PAST))))
	 ((EQ COM (QUOTE RESTORE))
	  (PROG NIL
		(SETQ MLABHIST
		      (CONS (CAR PAST)
			    MLABHIST))
		(MLABSET (QUOTE WS)
			 (CAR PAST)
			NIL)))
	 (T
	  (PROG NIL
		(SETQ MLABHIST (CDR PAST))
		(MLABSET
		 (QUOTE WS)
		 (COND
		  (MLABHIST (CAR MLABHIST))
		  (T NIL))
		NIL))))))
 EXPR)
(DEFPROP COMMENT (LAMBDA(X) NIL)FEXPR)
(DEFPROP COMMENT COMMENT TOPCOM)
(DEFPROP COMMENT T SACRED)

(DEFPROP ATOMLIST
	 (LAMBDA (X)
		 (COND ((NULL X) T)
		       ((LATOM (CAR X))
			(ATOMLIST (CDR X)))
		       (T NIL)))
	 EXPR)

(DEFPROP LATOM
	 (LAMBDA (X)
		 (AND X (ATOM X)
		      (NOT (NUMBERP X))))
	 EXPR)

(DEFPROP RENAME
 (LAMBDA (X Y)
  (PROG NIL
   TOP	(COND ((NOT (AND (LATOM (CAR X))
			 (LATOM (CADR X))))
	       (ERLIST(QUOTE(ILLEGAL FORM FOR RENAME)))))
	(MLABSET (CADR X) (MGET (CAR X))NIL)
	(RETURN (EVAL (LIST (QUOTE KILL)
			    (CAR X))))
 ))
 FEXPR)

(DEFPROP EV
	 (LAMBDA (X)
		 (PROG()(TERPRI) (PRINC (EVAL (READ)
				     ))
			(TERPRI)))
	 FEXPR)

(DEFPROP SWITCHSET
 (LAMBDA (SWITCH STATE)
  (PROG NIL
   TOP	(COND
	 ((NULL STATE)
	  (RETURN
	   (PROG2 (SET SWITCH
		       (NOT (EVAL SWITCH)))
		  NIL)))
	 ((EQ (CAR STATE) (QUOTE ON))
	  (RETURN (NOT (SET SWITCH T))))
	 ((EQ (CAR STATE) (QUOTE OFF))
	  (RETURN (SET SWITCH NIL))))
	(PRINLIST (QUOTE (TYPE ON OR OFF)))
	(PRINC(QUOTE #)) (SETQ STATE (LIST (PRE)))
	(GO TOP)))
 EXPR)

(DEFPROP WARNING
	 (LAMBDA (X Y)
		 (SWITCHSET (QUOTE WARNING)
			    X))
	 FEXPR)

(DEFPROP ALIAS
 (LAMBDA (X Y)
  (COND
   ((NOT (AND (LATOM (CAR X))
	      (LATOM (CADR X))))
    (ERLIST (QUOTE (ALIAS TAKES
			  TWO
			  NAMES))))
   ((GET (CADR X) (QUOTE SACRED))
    (ERLIST (CONS (CADR X)
		  (QUOTE (IS SACRED)))))
   (T (PROG2 (PUTPROP (CADR X)
		  (CAR X)
		  (QUOTE ALIAS))
	     NIL))))
 FEXPR)

(DEFPROP ALIASKILL
 (LAMBDA (X Y)
  (PROG (AINT IT)
   LOOP	(COND ((NULL X) (GO OUT))
	      ((NOT (LATOM (CAR X)))
	       (ERLIST(QUOTE (ILLEGAL FORM FOR ALIASKILL)))))
	(SETQ IT (CAR X))
	(COND ((NOT (GET IT (QUOTE ALIAS)))
	       (GO NOSUCH)))
	(REMPROP IT (QUOTE ALIAS))
	(SETQ X (CDR X))
	(GO LOOP)
   NOSUCH
	(SETQ AINT (CONS IT AINT))
	(SETQ X (CDR X))
	(GO LOOP)
   OUT	(COND ((NULL AINT) (RETURN NIL)))
	(PRINLIST (CONS (QUOTE CANNOT)
			(CONS (QUOTE FIND)
			      AINT)))
	(RETURN NIL)))
 FEXPR)


(DEFPROP NAMESORNUM
 (LAMBDA (X)
  (COND
   ((NULL X) NIL)
   ((NULL (CDR X))
    (OR (LATOM (CAR X)) (NONNEG (CAR X))))
   (T (EVAL (CONS (QUOTE OR)
		  (MAPCAR (FUNCTION LATOM)
			  X))
	    NIL))))
 EXPR)

(DEFPROP SUBSTITUTE (LAMBDA(X)(COND
((EVEN(LENGTH X))(ERLIST(QUOTE(SUBSTITUTE TAKES AN ODD NUMBER OF
                                      ARGUMENTS))))
(T(UNQUOTE(SUBSTLIS(DOTPAIROFF
    (MAPLIST(FUNCTION(LAMBDA(Q)(COND
     ((EVEN(LENGTH Q))(CAR Q))
     (T(UNQUOTE(CAR Q)))
           )))
           (REVERSE(CDR(REVERSE X)))))
            (UNQUOTE(CAR(LAST X)))
)))
))FEXPR)

(DEFPROP DOTPAIROFF(LAMBDA(X)(COND
 ((NULL X)NIL)
 (T(CONS(CONS(CADR X)(CAR X))(DOTPAIROFF(CDDR X))))
))EXPR)

(DEFPROP SUBSTLIS(LAMBDA(A Z)
 ((LAMBDA(PHI)(COND
   (PHI PHI)
   ((ATOM Z)Z)
   (T(CONS(SUBSTLIS A(CAR Z))(SUBSTLIS A(CDR Z))))
  )           )
  (SUBSTLIS1 A Z)
 ))EXPR)

(DEFPROP SUBSTLIS1(LAMBDA(A Z)(COND
 ((NULL A)NIL)
  ((EQUAL(CAAR A)Z)(CDAR A))
 (T(SUBSTLIS1(CDR A)Z))
))EXPR)

(DEFPROP ERTALK
	 (LAMBDA (X Y)
		 (SWITCHSET (QUOTE ERTALK)
			    X))
	 FEXPR)
(QUOTE (FILE M3))

(DEFPROP NONNEG
	 (LAMBDA (N) (AND (NUMBERP N)
			  (NOT (MINUSP N))))
	 EXPR)

(DEFPROP NONPOS
	 (LAMBDA (N)(OR(EQ N 0)
 (AND
   (NOT(ATOM N))
   (EQ(CAR N)(Q MINUS))
   (NONNEG(CADR N))  )) )EXPR)

(DEFPROP TALLPAR
	 (LAMBDA (X Y)
		 (SWITCHSET (QUOTE TALLPAR)
			    X))
	 FEXPR)

(DEFPROP ALLSTAR
         (LAMBDA(X Y)
                (SWITCHSET(QUOTE ALLSTAR)
                            X))
 FEXPR)

(DEFPROP SIMP
	 (LAMBDA (X Y)
		 (SWITCHSET (QUOTE SIMP) X))
	 FEXPR)

(DEFPROP CLEAN
	 (LAMBDA (X) (CLEAN2 (CLEAN1 X)))
	 EXPR)

(DEFPROP CLEAN1
 (LAMBDA (X)
  (COND
   ((AND (NUMBERP X) (MINUSP X))
    (LIST (QUOTE MINUS) (MINUS X)))
   ((ATOM X) X)
   ((AND (TALKP X) (ONEP (CDR X)))
    (CLEAN1 (CAR X)))
   ((TALKP X)
    (COND
     ((MINUSP (CAR X))
      (LIST (QUOTE MINUS)
	    (CLEAN1 (CONS (MINUS (CAR X))
			  (CDR X)))))
     (T (LIST (QUOTE QUOTIENT)
	      (CAR X)
	      (CDR X)))))
   (T (CONS (CLEAN1 (CAR X))
	    (CLEAN1 (CDR X))))))
 EXPR)

(DEFPROP CLEAN2
 (LAMBDA (X)
  (COND
   ((ATOM X) X)
   ((EQ (CAR X) (QUOTE PLUS))
    (CONS (CAR X)
	  (PORDD(MAPCAR (FUNCTION CLEAN2)
		  (COND ((EQ (CADR X) 0)
			 (CDDR X))
			(T (CDR X)))))))
   ((EQ (CAR X) (QUOTE EXPT))
    ((LAMBDA (JJ K)
      (COND
          ((EQ JJ(QUOTE E))
           (LIST(QUOTE EXPT)JJ K))
 ((EQUAL K (QUOTE (MINUS 1)))
	     (LIST (QUOTE QUOTIENT) 1 JJ))
	    ((EQ (LEAD K) (QUOTE MINUS))
	     (LIST (QUOTE QUOTIENT)
		   1
		   (LIST (QUOTE EXPT)
			 JJ
			 (CADR K))))
	    (T (LIST (QUOTE EXPT) JJ K))))
     (CLEAN2 (CADR X))
     (CLEAN2 (CADDR X))))
   ((EQ (CAR X) (QUOTE TIMES))
    ((LAMBDA (J)
      (COND
       ((EQ (CAR J) 1) (TIMESCOL (CDR J)))
       ((EQUAL (CAR J) (QUOTE (MINUS 1)))
	(LIST (QUOTE MINUS)
	      (TIMESCOL (CDR J))))
       ((AND(NOT(ATOM(CAR J)))(EQ (CAAR J) (QUOTE MINUS)))
	(LIST (QUOTE MINUS)
	      (TIMESCOL (CONS (CADAR J)
			      (CDR J)))))
       (T (TIMESCOL J))))
     (MAPCAR (FUNCTION CLEAN2) (CDR X))))
   (T (CONS (CLEAN2 (CAR X))
	    (CLEAN2 (CDR X))))))
 EXPR)

(DEFPROP TIMESCOL
 (LAMBDA (X)
  (PROG (TOP BOT NOW)
   LOOP	(COND ((NULL X) (GO OUT)))
	(SETQ NOW (CAR X))
	(COND
	 ((AND (EQ (LEAD NOW)
		   (QUOTE QUOTIENT))
	       (NUMBERP (CADR NOW))
	       (NUMBERP (CADDR NOW)))
	  (SETQ TOP (CONS NOW TOP)))
	 ((AND (EQ (LEAD NOW)
		   (QUOTE QUOTIENT))
	       (EQUAL (CADR NOW) 1))
	  (SETQ BOT (CONS (CADDR NOW) BOT)))
	 ((EQ (LEAD NOW) (QUOTE QUOTIENT))
	  (PROG2 (SETQ TOP (CONS (CADR NOW)
				 TOP))
		 (SETQ BOT (CONS (CADDR NOW)
				 BOT))))
	 (T (SETQ TOP (CONS NOW TOP))))
	(SETQ X (CDR X))
	(GO LOOP)
   OUT	(SETQ TOP(COND((OR(NULL TOP)(NULL(CDR TOP)))(REV TOP))(T(TORDD (REV TOP)))))
	(SETQ BOT(COND((OR(NULL BOT)(NULL(CDR BOT)))(REV BOT))(T(TORDD (REV BOT)))))
	(COND
	 ((NULL BOT)
	  (RETURN (COND ((CDR TOP)
			 (CONS (QUOTE TIMES)
			       TOP))
			(T (CAR TOP)))))
	 ((NULL TOP)
	  (RETURN
	   (COND ((CDR BOT)
		  (LIST (QUOTE QUOTIENT)
			1
			(CONS (QUOTE TIMES)
			      BOT)))
		 (T (LIST (QUOTE QUOTIENT)
			  1
			  (CAR BOT)))))))
	(RETURN
	 (LIST (QUOTE QUOTIENT)
	       (COND ((CDR TOP)
		      (CONS (QUOTE TIMES)
			    TOP))
		     (T (CAR TOP)))
	       (COND ((CDR BOT)
		      (CONS (QUOTE TIMES)
			    BOT))
		     (T (CAR BOT)))))))
 EXPR)


 (DEFPROP PTORD (LAMBDA (X) (PROG (W R)

       (SETQ R X)

 BACK  (SETQ W X)

       (SETQ X (CDR X))

       (COND ((NULL X) (GO OUT))

             ((ATOMX (CAR X)) (GO BACK)))

       (RPLACD W NIL)

  OUT  (RETURN (NCONC (REV R) X))

 ))EXPR)

 ( DEFPROP PORDD (LAMBDA (X) (COND

       ((NUMBERX (CAR X)) (NCONC (PTORD (CDR X)) (LIST (CAR X))))

       (T (PTORD X))

 ))EXPR)

 ( DEFPROP TORDD (LAMBDA (X) (COND

       ((NUMBERX (CAR X)) (CONS (CAR X) (PTORD (CDR X))))

       (T (PTORD X) )

 )) EXPR)

 (DEFPROP ATOMX (LAMBDA (X) (COND

       ((ATOM X) T)

       ((EQ (CAR X) (QUOTE TIMES)) (ATOMLX (CDR X)))

       ((EQ (CAR X) (QUOTE EXPT)) (AND (ATOM (CADR X)) (NUMBERP

                   (CADDR X))) )

       (T NIL) 

 ))EXPR )

 (DEFPROP ATOMLX (LAMBDA (X) (COND

       ((NULL X) T)

       ((ATOMX (CAR X)) (ATOMLX (CDR X)))

       (T NIL)

 ))EXPR)

 (DEFPROP NUMBERX (LAMBDA (X) (COND

       ((NULL X) T)

       ((ATOM X) (OR (NUMBERP X) (OPP X)))

       (T (AND (NUMBERX (CAR X)) (NUMBERX (CDR X))) )

 ))EXPR)



(DEFPROP SIMPLIFY
 (LAMBDA (X Y)
  (CLEAN
   (UNKLUDGE
    (SIMPLIFYA (KLUDGE (UNQUOTE (CAR X)))
	       NIL))))
 FEXPR)

(DEFPROP DERIV
 (LAMBDA (X Y)
  (PROG (EXPR GOAL COUNT VAR)
	(SETQ
	 X
	 (DERIVUNQUOTE
	  (MAPCAR (FUNCTION UNQUOTE) X)
	  T))
	(SETQ EXPR (SIMPLIFYA (CAR X) NIL))
	(COND
	 ((EQ (CAR EXPR) (QUOTE LAMBDA))
	  (ERLIST
	   (QUOTE (CANNOT YET
			  DIFFERENTIATE
			  FUNCTIONS)))))
	(SETQ X (CDR X))
	(PUMP)
   LOOP	(COND ((NULL X)
	       (RETURN (CLEAN EXPR))))
	(SETQ VAR (CAR X))
	(SETQ GOAL (CADR X))
	(SETQ COUNT 0)
   LITTLELOOP
	(COND ((EQUAL COUNT GOAL)
	       (GO LITTLEOUT)))
	(SETQ EXPR (SDIFF EXPR VAR))
	(SETQ COUNT (ADD1 COUNT))
	(GO LITTLELOOP)
   LITTLEOUT
	(SETQ X (CDDR X))
	(GO LOOP)))
 FEXPR)

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

(DEFPROP DEPENDENT
 (LAMBDA (X Y)
  (COND
   ((OR (NULL X) (NULL (CDR X)))
    (ERLIST (QUOTE (DEPENDENT MUST
			      BE
			      FOLLOWED
			      BY
			      AT
			      LEAST
			      TWO
			      VARIABLES))))
   ((NOT (ATOMLIST X))
    (ERLIST (QUOTE (ONLY ATOMS
			 DEPEND
			 ON
			 ONLY
			 ATOMS))))
   (T
    (PROG NIL
	  (PUTPROP
	   (CAR X)
	   (APPEND
	    (CDR X)
	    (WIPELIST
	     (CDR X)
	     (GET (CAR X) (QUOTE DEPENDS))))
	   (QUOTE DEPENDS))
	  (SETQ DEPENDLIST
		(PASTE (CAR X) DEPENDLIST))
	  (RETURN NIL)))))
 FEXPR)

(DEFPROP INDEPENDENT
 (LAMBDA (X Y)
  (COND
   ((OR (NULL X) (NULL (CDR X)))
    (ERLIST
     (QUOTE (INDEPENDENT MUST
			 BE
			 FOLLOWED
			 BY
			 AT
			 LEAST
			 TWO
			 VARIABLES))))
   ((NOT (ATOMLIST X))
    (ERLIST (QUOTE (ONLY ATOMS
			 DEPEND
			 ON
			 ONLY
			 ATOMS))))
   (T
    (PROG NIL
	  (PUTPROP
	   (CAR X)
	   (WIPELIST (CDR X)
		     (GET (CAR X)
			  (QUOTE DEPENDS)))
	   (QUOTE DEPENDS))
	  (COND
	   ((NULL (GET (CAR X)
		       (QUOTE DEPENDS)))
	    (SETQ DEPENDLIST
		  (WIPE (CAR X)
			DEPENDLIST))))
	  (RETURN NIL)))))
 FEXPR)

(DEFPROP WIPELIST
	 (LAMBDA (X Y)
		 (PROG NIL
		  LOOP (COND ((NULL X)
			      (RETURN Y)))
		       (SETQ Y (WIPE (CAR X)
				     Y))
		       (SETQ X (CDR X))
		       (GO LOOP)))
	 EXPR)

(DEFPROP DEPENDENCIES
 (LAMBDA (X Y)
  (PROG (L)
(COND((AND(NULL X)DEPENDLIST)(SETQ X DEPENDLIST))
      ((NULL X)(RETURN(PROG()(TERPRI)(PRINC(QUOTE NONE))(TERPRI)
                              (RETURN NIL)))))
	(COND
	 ((NOT (ATOMLIST X))
	  (ERLIST
	   (QUOTE (ONLY ATOMS
			CAN
			FOLLOW
			DEPENDENCIES)))))

   LOOP	(COND ((NULL X) (RETURN NIL)))
	(SETQ L
	      (GET (CAR X) (QUOTE DEPENDS)))
       (PRINLIST(MCONS(CAR X) COLON 
                         (COND((NULL L)(QUOTE (NONE)))(T L))))
	(SETQ X (CDR X))
	(GO LOOP)))
 FEXPR)

(DEFPROP KLUDGE
 (LAMBDA (X)
  (COND ((ATOM X) X)
	((NOT (INN (QUOTE DERIV) X)) X)
	((EQ (CAR X) (QUOTE DERIV))
	 (LIST (QUOTE HYPERDERIV)
	       (KLUDGE (CADR X))
	       (CONS (QUOTE PLUS)
		     (PAIROFF (CDDR X)))))
        ((CONS(KLUDGE(CAR X))
              (KLUDGE(CDR X))))))
 EXPR)

(DEFPROP PAIROFF
 (LAMBDA (X)
  (COND ((NULL X) NIL)
	(T (CONS (LIST (CAR X) (CADR X))
		 (PAIROFF (CDDR X))))))
 EXPR)

(DEFPROP UNKLUDGE
 (LAMBDA (X)
  (COND
   ((ATOM X) X)
   ((NOT (INN (QUOTE HYPERDERIV) X)) X)
   ((EQ (CAR X) (QUOTE HYPERDERIV))
    (CONS
     (QUOTE DERIV)
     (CONS
      (UNKLUDGE (CADR X))
      (COND
       ((EQ (CAADDR X) (QUOTE PLUS))
	(UNPAIR (CDDR (CADDR X))))
       (T
	(UNPAIR
	 (LIST
	  (LIST (CAADDR X)
		(CAADR (CADDR X))))))))))
   ((CONS(UNKLUDGE(CAR X))
         (UNKLUDGE(CDR X))))))
 EXPR)

(DEFPROP UNPAIR
 (LAMBDA (X)
  (COND ((NULL X) NIL)
	(T (CONS (CAAR X)
		 (CONS (CADAR X)
		       (UNPAIR (CDR X)))))))
 EXPR)

(DEFPROP DIFFDERIV
 (LAMBDA (E X)
  (COND
   ((EQ (CADR E) X) ZEROT)
   (T (CONS (CAR E)
	    (CONS (CADR E)
		  (DIFFRAISE X
			     (CDDR E)))))))
 EXPR)

(DEFPROP DIFFRAISE
 (LAMBDA (VAR LIST)
  (COND
   ((MEMBER VAR LIST)
    (COND
     ((EQ VAR (CAR LIST))
      (CONS (CAR LIST)
	    (CONS (ADDK ONET (CADR LIST))
		  (CDDR LIST))))
     (T
      (CONS
       (CAR LIST)
       (CONS (CADR LIST)
	     (DIFFRAISE VAR
			(CDDR LIST)))))))
   (T (CONS VAR (CONS ONET LIST)))))
 EXPR)

(DEFPROP INN
 (LAMBDA (X Y)
	 (COND ((EQ X Y) T)
	       ((ATOM Y) NIL)
	       (T (OR (INN X (CAR Y))
		      (INN X (CDR Y))))))
 EXPR)
(QUOTE (FILE M456))

(DEFPROP SIMPDERIV
 (LAMBDA (*X Y Z)
  (COND
   ((NOT Z)
    (SIMPDERIV
     (CONS
      (QUOTE DERIV)
      (MAPCAR
       (FUNCTION (LAMBDA (J)
			 (SIMPLIFYA J NIL)))
       (CDR *X)))
     Y
     T))
   ((NOT
     (EVAL
      (CONS
       (QUOTE AND)
       (MAPCAR
	(FUNCTION (LAMBDA (J)
			  (DEPENDS (CADR *X)
				   J)))
	(INDVAR (CDDR *X))))
      ))
    ZEROT)
   (T *X)))
 EXPR)

(DEFPROP INDVAR
 (LAMBDA (X)
  (COND ((NULL X) NIL)
	(T (CONS (CAR X)
		 (INDVAR (CDDR X))))))
 EXPR)


(DEFPROP REMDIF
 (LAMBDA (U)
  (COND ((ATOM U) U)
	((EQUAL (CAR U) (QUOTE DIFFERENCE))
	 (LIST (QUOTE PLUS)
	       (REMDIF (CADR U))
	       (LIST (QUOTE MINUS)
		     (REMDIF (CADDR U)))))
	(T (CONS (REMDIF (CAR U))
		 (REMDIF (CDR U))))))
 EXPR)

(DEFPROP TERM
 (LAMBDA (X Y)
  (PROG (GOAL COUNT)
	(SETQ X
	      (MAPCAR (FUNCTION(LAMBDA(J)(SPT(REMDIF(UNQUOTE J))))) X))
	(COND
	 ((OR (NULL X)
	      (NULL (CDR X))
	      (ATOM (CADR X))
	      (NOT (NONNEG (CAR X)))
	      (ZEROP (CAR X))
	      (CDDR X)
     (EQ(CAADR X)(QUOTE LAMBDA))
	      (LESSP (LENGTH (CDADR X))
		     (CAR X)))
	  (ERLIST (QUOTE (ILLEGAL USE
				  OF
				  TERM)))))
	(SETQ GOAL (CAR X))
	(SETQ X (CDADR X))
	(SETQ COUNT 1)
   LOOP	(COND ((EQUAL COUNT GOAL)
	       (RETURN (CAR X))))
	(SETQ COUNT (ADD1 COUNT))
	(SETQ X (CDR X))
	(GO LOOP)))
 FEXPR)

(DEFPROP KILL
 (LAMBDA (X Y)
  (COND
   ((EQ (CAR X) (QUOTE HISTORY))
(PROG2(MLABSET(QUOTE WS)NIL NIL)
      (SETQ MLABHIST NIL)
      (SETQ EXPRLIST(WIPE(QUOTE WS)EXPRLIST))
      (SETQ EQUATLIST(WIPE(QUOTE WS)EQUATLIST))
      (SETQ FUNLIST(WIPE(QUOTE WS)FUNLIST))
))
   ((EQ (CAR X) (QUOTE ALL))
    (SETQ
     MLABHIST
     (SETQ
      EXPRLIST
      (SETQ
       EQUATLIST
       (SETQ
	FUNLIST
	(MLABSET
	 (QUOTE WS)
	 (PROG2 (MAP
	  (FUNCTION
	   (LAMBDA (J)
	    (PROG2 (MAP
	     (FUNCTION
	      (LAMBDA (K)
	       (REMPROP
		(CAR K)
		(QUOTE MLAB))))
(CAR J))NIL)))
	  (LIST EXPRLIST EQUATLIST FUNLIST)
) NIL) NIL))))))
   (T (BOOKKEEP X (QUOTE KILL)))))
 FEXPR)
(QUOTE (FILE MLB))

(DEFPROP REPEAT1
	 (LAMBDA (ZX)
		 (PROG()
     (TERPRI)
    (CHARYBDIS ZX 1 (LINELENGTH NIL))
		       ))
	 EXPR)

(DEFPROP CONTINUE
 (LAMBDA NIL
  (PROG (		  EXPR
		  )
   LOOP (TERPRI)
	 (PRINC (QUOTE #))
     	(SETQ EXPR (ERRSET (UNQUOTE 
((LAMBDA (J) (COND((ATOM J) J)
 ((NULL (CAR J)) (ERLIST (QUOTE (ADJACENT TERMS))))(J)))(PRE)))
			   ERTALK))
	(COND
	 ((AND EXPR (CAR EXPR))
	  (SETQ EXPR
		(ERRSET (MLABSET (QUOTE WS)
			      (CAR EXPR)
			T)
			ERTALK)))
	 (T (GO LOOP)))
	(COND (EXPR (SETQ EXPR (CAR EXPR)))
	      (T (GO LOOP)))
	(SETQ MLABHIST (CONS EXPR MLABHIST))
	(COND
	 ((AND(NOT(ATOM EXPR))(EQ (CAR EXPR) (QUOTE LAMBDA)))
	  (SETQ EXPR
		(LIST (QUOTE SETQ)
		      (CONS (QUOTE WS)
			    (CADR EXPR))
		      (CADDR EXPR)))))
       (TERPRI)
	(ERRSET (REPEAT1 EXPR) ERTALK)
	(GO LOOP)))
 EXPR)
(QUOTE (FILE MTH))


(DEFPROP MATHLAB
 (LAMBDA NIL
	 (PROG ()
   (COND(OLDSYS(RETURN(CONTINUE))))
	       (SETQ EXPOP 0)
	       (SETQ EXPON 0)
	       (SETQ ORDLB (QUOTE (NIL)))
	       (SETQ ONET (QUOTE (1 . 1)))
	       (SETQ ZEROT (QUOTE (0 . 1)))
	       (SETQ MONET (QUOTE (-1 . 1)))
(SETQ
 GRADLIST
 (MAPCAR
  (FUNCTION (LAMBDA (Z)
   (PROG2  (PUTPROP (CAR Z)
       (LIST(CAADR Z)(NCONS(SIMPLIFYA
           (CAR(CADADR Z))NIL)))
		       (QUOTE GRAD))
  (CAR Z))))
SETUPLIST))
(MAPC(FUNCTION(LAMBDA(J)(SET J NIL)))
     (QUOTE(EXPRLIST EQUATLIST FUNLIST WARNING
    MLABHIST ERTALK TALLPAR SIMP DEPENDLIST 
   ALLSTAR)))
(SETQ OLDSYS T)
(TERPRI)
(PRINLIST(QUOTE(# MEANS MATHLAB IS LISTENING)))
	       (RETURN (CONTINUE))))
 EXPR)

(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)))))
)))

(DEFPROP VARORDER
 (LAMBDA (X Y)
  (PROG NIL
	(COND
	 ((NULL X) (RETURN (SETQ ORDL NIL)))
	 ((NOT (ATOMLIST X))
	  (ERLIST(QUOTE(ILLEGAL FORM FOR VARORDER)))))
	(SETQ ORDL X)
	(RETURN NIL)))
 FEXPR)

(DEFPROP DISTEXP
 (LAMBDA (X Y)
  (PROG ()
	(COND ((NULL X)
	       (RETURN (PROG2 (SETQ EXPOP 0)
			      NIL))))
	(COND
	 ((OR(CDR X)(NOT(NONNEG(CAR X))))
           (ERLIST(QUOTE(WRONG FORM FOR DISTEXP)))))
	(SETQ EXPOP (CAR X))
	(RETURN NIL)))
 FEXPR)
(QUOTE (FILE L'S))

(SETQ COLON (QUOTE :))

(MAPCAR(FUNCTION(LAMBDA (X)
	 (PROG2 (PUTPROP X X (QUOTE TOPCOM))
		(PUTPROP X
			 T
			 (QUOTE SACRED)))))
(QUOTE 
 (INVENTORY SAVE
	    RESTORE
	    REPEAT
	    KILL
	    RENAME
	    EV
	    WARNING
	    ALIAS
	    ALIASKILL
	    ERTALK
	    VARORDER
	    DISTEXP
	    SIMP
	    TALLPAR
            ALLSTAR
	    DEPENDENT
	    INDEPENDENT
	    DEPENDENCIES
	    )))

(DEFPROP STORE SAVE TOPCOM)
(DEFPROP YES T SACRED)
(DEFPROP NO T SACRED)
(DEFPROP POSITIVE T SACRED)
(DEFPROP NEGATIVE T SACRED)
(DEFPROP ZERO T SACRED)
(MAPCAR(FUNCTION(LAMBDA (X)
	 (PROG2 (PUTPROP X T (QUOTE INTCOM))
		(PUTPROP X
			 T
			 (QUOTE SACRED)))))
(QUOTE  (SUBSTITUTE SIMPLIFY
	     DERIV
	     TERM
             SOLVE
	     INTEGRATE
	     RATSIMP
	     PF
	     PPF)))

(DEFPROP DERIV DIFFDERIV DIFFFN)
(DEFPROP DERIV SIMPDERIV OPERATORS)
(SETQ OLDSYS NIL)
(DEFPROP DSKWIDTH T SPECIAL)
(DEFPROP LPTWIDTH T SPECIAL)
(DEFPROP OUTNAME T SPECIAL)

(SETQ LPTWIDTH 132.)
(SETQ DSKWIDTH 72.)
(SETQ OUTNAME NIL)


(DEFPROP DSKDISP (LAMBDA(X)(PROG(FIN NAMELIST BADLIST)
LOOP (COND((NULL X)(GO OUT))
          ((EQ(CAR X)(QUOTE FIN))(SETQ FIN T))
          ((EQ(CAR X)(QUOTE TTY))(SETQ DSKWIDTH 72.))
          ((EQ(CAR X)(QUOTE LPT))(SETQ DSKWIDTH LPTWIDTH))
          ((NUMBERP(CAR X))(SETQ DSKWIDTH(CAR X)))
          ((NOT(LATOM(CAR X)))(ERLIST(QUOTE(DSKDISP EXPECTS ATOMIC 
                                                 ARGUMENTS))))
          ((GET(CAR X)(QUOTE MLAB))(SETQ NAMELIST(CONS(CAR X)NAMELIST)))
      (T(SETQ BADLIST(CONS(CAR X)BADLIST)))
     )
(SETQ X(CDR X))
(GO LOOP)
OUT (COND((NULL OUTNAME)(EVAL
             (APPEND(QUOTE(OUTPUT DISPFILE DSK:))
                     (LIST(SETQ OUTNAME(CONS(MLGEN)(QUOTE DSP))))))))
(OUTC (QUOTE DISPFILE) NIL)
(LINELENGTH DSKWIDTH)
(COND(NAMELIST(EVAL(CONS(QUOTE REPEAT)(REVERSE NAMELIST)))))
(OUTC NIL FIN)
(TERPRI)
(COND(BADLIST(PROG2(PRINLIST(APPEND(QUOTE(CANNOT FIND))
                 (REVERSE BADLIST)))(TERPRI))))
(PRINC(CAR OUTNAME))
(PRINC PT)
(PRINC(CDR OUTNAME))
(PRINC SP)
(PRINC(COND(FIN(QUOTE CLOSED))(T(QUOTE OPEN))))
(TERPRI)
(RETURN(COND(FIN(SETQ OUTNAME NIL))))
))FEXPR)

(DEFPROP DSKDUMP (LAMBDA(X)(PROG(DUMPNAME)
(OUTC(EVAL(APPEND(QUOTE(OUTPUT DSK:))(LIST(SETQ DUMPNAME(CONS
   (MLGEN)(QUOTE DMP)))))))
(LINELENGTH 72.)
(MAPC(FUNCTION(LAMBDA(J)(MAPC(FUNCTION(LAMBDA(K)
                                  (PRINT(LIST(QUOTE SETQ)K(MGET K)))))
                             J)))
              (LIST (WIPE(QUOTE WS)EXPRLIST)
                  (WIPE(QUOTE WS) EQUATLIST)
                  (WIPE(QUOTE WS) FUNLIST))
)
(OUTC NIL T)
(TERPRI)
(PRINC(CAR DUMPNAME))
(PRINC PT)
(PRINC(CDR DUMPNAME))
(TERPRI)
(RETURN NIL)
))FEXPR)

(DEFPROP DSKLOAD(LAMBDA(X)(PROG (NOW HOLD)
(COND((OR(NULL X)(NOT(EVAL(CONS(QUOTE AND)(MAPCAR(FUNCTION LATOM)X)))))
     (ERLIST(QUOTE(DSKLOAD EXPECTS  ATOMIC ARGUMENTS)))))
OUTERLOOP (INC(EVAL(APPEND(QUOTE(INPUT DSK:))(LIST(CONS(CAR X)(QUOTE DMP))))))
(SETQ HOLD(CAR X))
LOOP (SETQ NOW(ERRSET (READ)NIL))
(COND((ATOM NOW)(GO OUTFILE)))
(SETQ NOW(CAR NOW))
(MLABSET(CADR NOW)(CADDR NOW)NIL)
(GO LOOP)
OUTFILE(TERPRI)
(PRINC(CAR X))
(PRINC PT)
(PRINC(QUOTE DMP))
 (SETQ X(CDR X))
(COND((NULL X)(RETURN NIL)))
(GO OUTERLOOP)
))FEXPR)

(DEFPROP LPTWIDTH(LAMBDA(X)(PROG()
(COND((OR(NULL X)(CDR X)(NOT(NUMBERP(CAR X))))
      (ERLIST(QUOTE(LPTWIDTH EXPECTS ONE NUMERICAL ARGUMENT)))))
(SETQ LPTWIDTH (CAR X))
(RETURN NIL)
))FEXPR)

(DEFPROP DSKDISP DSKDISP TOPCOM)
(DEFPROP DSKDISP T SACRED)
(DEFPROP DSKDUMP DSKDUMP TOPCOM)
(DEFPROP DSKDUMP T SACRED)
(DEFPROP DSKLOAD DSKLOAD TOPCOM)
(DEFPROP DSKLOAD T SACRED)
(DEFPROP LPTWIDTH LPTWIDTH TOPCOM)
(DEFPROP LPTWIDTH T SACRED)