Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50216/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)