mirror of
https://github.com/PDP-10/its.git
synced 2026-03-02 01:50:24 +00:00
259 lines
9.5 KiB
Common Lisp
259 lines
9.5 KiB
Common Lisp
;;; -*- Mode: Lisp; Package: Macsyma -*-
|
||
;;; Checking functions for PRIMER FASL
|
||
;;; (c) Copyright 1982 Masssachusetts Institute of Technology
|
||
|
||
(macsyma-module check)
|
||
|
||
(load-macsyma-macros mrgmac)
|
||
|
||
(DECLARE (SPECIAL CLABEL DLABEL $% $LABELS $LINENUM EXAMPLE1
|
||
PRAC-EXAMPLE1 PRAC-EXAMPLE2 RADCANEXAMPLE)
|
||
(*EXPR MEVAL STRIPDOLLAR DISPLA MGRIND MAKSTRING MACSYMA RETRIEVE))
|
||
|
||
(DEFUN FUNCHKP (A B)
|
||
(DO X (MREAD) (MREAD) NIL
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., we'll use this one.|)
|
||
(RETURN (MACSYMA '((MDEFINE) (($F) $X)
|
||
((MPLUS) ((MTIMES) 2 ((MEXPT) $X 2))
|
||
((MTIMES) 2 $X) 4)))))
|
||
((NOT (EQ (CAAR X) (CAR A)))
|
||
(TERPRI) (PRINC '|Not a function definition, use := .|) NIL)
|
||
((NOT (EQ (CAAADR X) (CAAR B)))
|
||
(TERPRI) (PRINC '|Please use |)
|
||
(PRINC (FULLSTRIP1 (CAAR B)))
|
||
(PRINC '| as the function name.|) NIL)
|
||
((NOT (EQ (CADADR X) (CADR B)))
|
||
(TERPRI) (PRINC '|Please use |)
|
||
(PRINC (FULLSTRIP1 (CADR B)))
|
||
(PRINC '| for the variable.|) NIL)
|
||
(($FREEOF (CADR B) (CADDR X))
|
||
(TERPRI) (PRINC '|Please use |)
|
||
(PRINC (FULLSTRIP1 (CADR B)))
|
||
(PRINC '| in the function itself.|) NIL)
|
||
(T (RETURN (MPRINEVAL))))
|
||
(TERPRI) (PRINC '|Try again.|)))
|
||
|
||
(DEFUN ASSIGNCHKP (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., I'll do it for you.|)
|
||
(MACSYMA '((MSETQ) $A 3)) 'NOLABEL)
|
||
((NOT (EQ 'MSETQ (CAAR X)))
|
||
(TERPRI) (PRINC '|Not an assignment.|) NIL)
|
||
((NOT (EQ '$A (CADR X)))
|
||
(TERPRI) (PRINC '|Please use A.|) NIL)
|
||
((NOT (MNUMP (CADDR X)))
|
||
(COND ((NOT (EQ 'MMINUS (CAR (CAADDR X))))
|
||
(TERPRI) (PRINC '|Please assign a number value.|) NIL)
|
||
(T T)))
|
||
(T T)))
|
||
|
||
|
||
(DEFUN CHKEXONEP (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., I'll do it for you.|)
|
||
(MACSYMA EXAMPLE1) 'NOLABEL)
|
||
((ATOM X)
|
||
(TERPRI) (PRINC '|Oops, you typed the ; too soon.|) NIL)
|
||
((EQ 'MPLUS (CAAR X))
|
||
(TERPRI) (PRINC '|The X+1 should be in parentheses.|) NIL)
|
||
((EQ 'MTIMES (CAAR X))
|
||
(TERPRI) (PRINC '|Use ^ or two asterisks for exponentiation.|) NIL)
|
||
((NOT (MNUMP (CADDR X)))
|
||
(TERPRI) (PRINC '|Use a small positive number for the exponent, please.|) NIL)
|
||
((AND (MNUMP (CADDR X)) (GREATERP (CADDR X) 6))
|
||
(TERPRI) (PRINC '|MACSYMA will only expand up to the value|)
|
||
(TERPRI) (PRINC '|of MAXPOSEX or MAXNEGEX. Their initial|)
|
||
(TERPRI) (PRINC '|value is 6.|) NIL)
|
||
((NOT (PALIKE EXAMPLE1 X)) NIL)
|
||
(T T)))
|
||
|
||
(DEFUN POLYCHK (A)
|
||
((LAMBDA (VAR)
|
||
(COND ((OR (EQ '$EXIT A) (EQ '$QUIT A)) (PRIMER-EXIT))
|
||
((EQ '$NO A)
|
||
(TERPRI) (PRINC '|O.K., we'll use this one.|)
|
||
(DISPLA (POWER PRAC-EXAMPLE1 2))
|
||
(MACSYMA (POWER PRAC-EXAMPLE1 2)) 'NOLABEL)
|
||
((ATOM A)
|
||
(TERPRI) (PRINC '|That polynomial won't be very interesting.|)
|
||
(TERPRI) (PRINC '|Let's use |)
|
||
(DISPLA (POWER PRAC-EXAMPLE1 2))
|
||
(MACSYMA (POWER PRAC-EXAMPLE1 2)) 'NOLABEL)
|
||
((MEMQ (CAAR A) '(MPLUS MTIMES))
|
||
(TERPRI) (PRINC '|Ok, to make that a bit more interesting,|)
|
||
(TERPRI) (PRINC '|let's square it.|)
|
||
(MACSYMA (POWER A 2)) 'NOLABEL)
|
||
((EQ (CAAR A) 'MEXPT)
|
||
(COND ((ATOM (CADR A))
|
||
(TERPRI) (PRINC '|That polynomial won't be very interesting.|)
|
||
(TERPRI) (PRINC '|Let's use |)
|
||
(DISPLA (POWER PRAC-EXAMPLE1 2))
|
||
(MACSYMA (POWER PRAC-EXAMPLE1 2)) 'NOLABEL)
|
||
((FREE (CADR A) VAR)
|
||
(FREE (CADDR A) VAR))
|
||
(T (AND (FIXP (CADDR A))
|
||
(GREATERP (CADDR A) 0.)
|
||
(POLYP (CADR A))))))
|
||
((EQ (CAAR A) 'MDEFINE)
|
||
(TERPRI) (PRINC '|It isn't necessary to define it as a function.|) NIL)
|
||
((NOT (MEMQ (CAAR A)'(MPLUS MTIMES MEXPT)))
|
||
(TERPRI) (PRINC '|Oops.|) NIL)
|
||
(T T))) '$X))
|
||
|
||
(DEFUN VALUEP (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., I'll do it for you.|)
|
||
(MACSYMA '(($F) 3)) 'NOLABEL)
|
||
((NOT (EQ (CAAR X) '$F))
|
||
(TERPRI) (PRINC '|Oops, wrong function name.|) NIL)
|
||
((NOT (OR (MMMINUSP (CADR X)) (MNUMP (CADR X))))
|
||
(TERPRI) (PRINC '|Please use a number for the value.|) NIL)
|
||
(T T)))
|
||
|
||
(DEFUN SUBEXAMPLE1 (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K. I'll do it for you.|)
|
||
(MACSYMA '(($SUBSTITUTE) 1 ((MPLUS) ((MEXPT) ((%SIN) $X) 2)
|
||
((MEXPT) ((%COS) $X) 2)) $%))
|
||
'NOLABEL)
|
||
((ATOM X)
|
||
(TERPRI) (PRINC '|Oops, you typed the ; too soon.|) NIL)
|
||
((OR (EQUAL '(($SUBSTITUTE) 1 ((MPLUS) ((MEXPT) ((%SIN) $X) 2)
|
||
((MEXPT) ((%COS) $X) 2)) $%)
|
||
X)
|
||
(EQUAL '(($SUBSTITUTE) ((MPLUS) 1 ((MMINUS)
|
||
((MEXPT) ((%SIN) $X) 2)))
|
||
((MEXPT) ((%COS) $X) 2) $%) X)
|
||
(EQUAL '(($SUBSTITUTE) ((MPLUS) 1 ((MMINUS)
|
||
((MEXPT) ((%COS) $X) 2)))
|
||
((MEXPT) ((%SIN) $X) 2) $%) X)))
|
||
((NOT (EQ '$SUBSTITUTE (CAAR X)))
|
||
(TERPRI) (PRINC '|That should be SUBST.|) NIL)
|
||
(T (SUBCHK X))))
|
||
|
||
(DEFUN SUBEXAMPLE2 (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K. I'll do it for you.|)
|
||
(MACSYMA '(($RATSUBST) 1 ((MPLUS) ((MEXPT) ((%SIN) $X) 2)
|
||
((MEXPT) ((%COS) $X) 2)) $%))
|
||
'NOLABEL)
|
||
((ATOM X)
|
||
(TERPRI) (PRINC '|Oops, you typed the ; too soon.|) NIL)
|
||
((OR (EQUAL '(($RATSUBST) 1 ((MPLUS) ((MEXPT) ((%SIN) $X) 2)
|
||
((MEXPT) ((%COS) $X) 2)) $%)
|
||
X)
|
||
(EQUAL '(($RATSUBST) ((MPLUS) 1 ((MMINUS)
|
||
((MEXPT) ((%SIN) $X) 2)))
|
||
((MEXPT) ((%COS) $X) 2) $%) X)
|
||
(EQUAL '(($RATSUBST) ((MPLUS) 1 ((MMINUS)
|
||
((MEXPT) ((%COS) $X) 2)))
|
||
((MEXPT) ((%SIN) $X) 2) $%) X)))
|
||
((NOT (EQ '$RATSUBST (CAAR X)))
|
||
(TERPRI) (PRINC '|That should be RATSUBST.|) NIL)
|
||
(T (SUBCHK X))))
|
||
|
||
(DEFUN SUBCHK (X)
|
||
(COND ((EQUAL 1 (CADR X))
|
||
(COND ((NOT (EQUAL '((MPLUS) ((MEXPT) ((%SIN) $X) 2)
|
||
((MEXPT) ((%COS) $X) 2))
|
||
(CADDR X)))
|
||
(TERPRI) (PRINC '|The thing you are substituting for |)
|
||
(TERPRI) (PRINC '|should be SIN(X)^2+COS(X)^2 for this method.|) NIL)
|
||
(T T)))
|
||
((EQUAL '((MPLUS) 1 ((MMINUS) ((MEXPT) ((%SIN) $X) 2))) (CADR X))
|
||
(COND ((NOT (EQUAL '((MEXPT) ((%COS) $X) 2) (CADDR X)))
|
||
(TERPRI) (PRINC '|The thing you are substituting for |)
|
||
(TERPRI) (PRINC '|should be COS(X)^2 for this method.|) NIL)
|
||
(T T)))
|
||
((EQUAL '((MPLUS) 1 ((MMINUS) ((MEXPT) ((%COS) $X) 2))) (CADR X))
|
||
(COND ((NOT (EQUAL '((MEXPT) ((%SIN) $X) 2) (CADDR X)))
|
||
(TERPRI) (PRINC '|The thing you are substituting for |)
|
||
(TERPRI) (PRINC '|should be SIN(X)^2 for this method.|) NIL)
|
||
(T T)))
|
||
((NOT (MEMBER (CADR X)
|
||
'(1 ((MPLUS) 1 ((MMINUS) ((MEXPT) ((%COS) $X) 2)))
|
||
((MPLUS) 1 ((MMINUS) ((MEXPT) ((%SIN) $X) 2))) )))
|
||
(TERPRI) (PRINC '|Use 1, 1-SIN(X)^2, or 1-COS(X)^2 as something|)
|
||
(TERPRI) (PRINC '|to substitute in.|) NIL)
|
||
((NOT (EQ (CADDDR X) DLABEL))
|
||
(TERPRI) (PRINC '|Use % or check your D-line number.|) NIL)
|
||
(T NIL)))
|
||
|
||
(DEFUN CHKRADCAN (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K.,I'll do it for you.|)
|
||
(MACSYMA RADCANEXAMPLE) 'NOLABEL)
|
||
((ATOM X)
|
||
(TERPRI) (PRINC '|Oops, you typed the ; too soon.|) NIL)
|
||
((NOT (ISITIN '%LOG X))
|
||
(TERPRI) (PRINC '|The word LOG is used just like that.|) NIL)
|
||
((NOT (PALIKE RADCANEXAMPLE X)) NIL)
|
||
(T T)))
|
||
|
||
(DEFUN PE2CHK (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K.,I'll do it for you.|)
|
||
(MACSYMA PRAC-EXAMPLE2) 'NOLABEL)
|
||
((ATOM X)
|
||
(TERPRI) (PRINC '|Oops, you typed the ; too soon.|) NIL)
|
||
((PALIKE '((MEXPT) ((MPLUS) ((MEXPT) $X 2) 3) ((MMINUS) 1))
|
||
X))
|
||
((NOT (PALIKE PRAC-EXAMPLE2 X)) NIL)
|
||
(T T)))
|
||
|
||
(DEFUN DOITYOURSELF (X)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., never mind.|) 'NOLABEL)
|
||
((NULL X)
|
||
(TERPRI) (PRINC '|Oops, that wasn't much of an expression.|)
|
||
(TERPRI) (PRINC CLABEL) NIL)
|
||
(T T)))
|
||
|
||
(DEFUN SYNCHK (FUN PAT)
|
||
(DO ((X (MREAD) (MREAD))) (NIL)
|
||
(COND ((OR (EQ '$EXIT X) (EQ '$QUIT X)) (PRIMER-EXIT))
|
||
((EQ '$NO X)
|
||
(TERPRI) (PRINC '|O.K., I'll show you.|)
|
||
(DISPLA PAT)
|
||
(RETURN (MACSYMA PAT)) 'NOLABEL)
|
||
((SYNCHK2 FUN PAT X) (RETURN (MPRINEVAL)))
|
||
(T (TERPRI) (PRINC '|Try again.|)))))
|
||
|
||
(DEFUN SYNCHK2 (FUN PAT X)
|
||
(COND ((ATOM X)
|
||
(COND ((EQ (GETOP (CAR FUN)) X)
|
||
(TERPRI) (PRINC '|Oops, that was just |)
|
||
(MGRIND (GETOP (CAR FUN)) NIL)
|
||
(PRINC '|, try|)
|
||
(PRINC (FULLSTRIP1 PAT)) NIL)
|
||
((NUMBERP X)
|
||
(TERPRI) (PRINC '|Oops, that was just a number, what about |)
|
||
(MGRIND (GETOP (CAR FUN)) NIL)
|
||
(PRINC '|/?|) NIL)
|
||
(T (TERPRI) (PRINC '|Oops, you typed the ; too soon.|))) NIL)
|
||
((NOT (PALIKE PAT X)) NIL)
|
||
(T T)))
|
||
(DEFUN PARTCHK (CMD PAT)
|
||
(DO ((X (MREAD) (MREAD))) (NIL)
|
||
(COND ((ATOM X)
|
||
(TERPRI) (PRINC '|Aw, come on, this is easy.|) NIL)
|
||
((NOT (EQ CMD (CAAR X)))
|
||
(COND ((MEMQ (CAR (PLIST (CAAR X))) '(SUBR LSUBR EXPR FEXPR))
|
||
(TERPRI) (PRINC '|Please use the |)
|
||
(PRINC (FULLSTRIP1 CMD))
|
||
(PRINC '| command.|))
|
||
(T (TERPRI) (PRINC '|Check your spelling.|))) NIL)
|
||
((EQ '$END (MEVAL X))
|
||
(TERPRI) (PRINC '|Whoops, that "PART" is off the end of the expression.|) NIL)
|
||
((PALIKE PAT (MPRINEVAL)) (RETURN T)))
|
||
(TERPRI) (PRINC '|Try again.|) (TERPRI))) |