archive/share/lisp/ntrig.trl

   1 ;;; -*- Mode: Lisp; Package: Macsyma -*-
   2 ;;; Translated code for DSK:SHARE1;NTRIG 2
   3 ;;; Written on "Saturday, Dec 31, 1983  5:44pm", from MACSYMA 304
   4 ;;; Translated for JPG
   5
   6 ;;; TRANSL-AUTOLOAD version by GJC0 on MONDAY, July 4, 1983, at 1:49:49
   7 ;;; TRHOOK version 5 TRMODE version 73 DCL version 5/29/82 8:19:42
   8 ;;; MCOMPI version NIL TRDATA version 68 ACALL version NIL
   9 ;;; FCALL version NIL TRANSQ version NIL MDEFUN version NIL
  10 ;;; MTAGS version NIL TRPRED version 6 TROPER version 15
  11 ;;; TRANSF version 11 TRANS5 version NIL TRANS4 version 29
  12 ;;; TRANS3 version NIL TRANS2 version NIL TRANS1 version NIL
  13 ;;; TRUTIL version 26 TRANSL version 1157 TRANSS version 80
  14 (includef (cond ((status feature ITS) '|DSK:LIBMAX;TPRELU >|)
  15                 ((status feature Multics) '|translate|)
  16                 ((status feature Unix) '|libmax/tprelu.l|)
  17                 (t (error '|Unknown system, see GJC@MIT-MC|))))
  18
  19 (eval-when (compile eval)
  20   (or (status feature lispm)
  21       (setq *infile-name-key*
  22                ((lambda (file-name)
  23                            ;; temp crock for multics.
  24                           (cond ((eq (typep file-name) 'list)
  25                                  (namestring file-name))
  26                                 (t file-name)))
  27                   (truename infile)))))
  28
  29 (eval-when (compile)
  30    (setq $tr_semicompile 'NIL)
  31    (setq forms-to-compile-queue ()))
  32
  33 (comment |DSK:SHARE1;NTRIG 2|)
  34
  35 (DEF-MTRVAR $NUMER (QUOTE $NUMER) 1.)
  36 (DEFMTRFUN-EXTERNAL ($USIN $ANY MDEFINE NIL NIL))
  37 (DEFMTRFUN-EXTERNAL ($UCOS $ANY MDEFINE NIL NIL))
  38 (DEFMTRFUN-EXTERNAL ($USIN1 $ANY MDEFINE NIL NIL))
  39 (DEFMTRFUN-EXTERNAL ($UCOS1 $ANY MDEFINE NIL NIL))
  40 (DECLARE (SPECIAL $N))
  41 (DEF-MTRVAR *AFTERFLAG (QUOTE *AFTERFLAG) 1.)
  42
  43 (DEFPROP $USIN T TRANSLATED)
  44 (ADD2LNC (QUOTE $USIN) $PROPS)
  45 (DEFMTRFUN ($USIN $ANY MDEFINE NIL NIL) ($N) NIL (MUL* (SIMPLIFY (LIST (QUOTE (%SIGNUM)) ((LAMBDA (|tr-gensym~0|) (UNWIND-PROTECT (PROGN (NUMERSET (QUOTE $NUMER) |tr-gensym~0|) ((LAMBDA ($NUMER) NIL (SIMPLIFY (LIST (QUOTE (%SIN)) (DIV (MUL* $N (QUOTE $%PI)) 10.)))) |tr-gensym~0|)) (NUMERSET (QUOTE $NUMER) (TRD-MSYMEVAL $NUMER (QUOTE $NUMER))))) T))) (SIMPLIFY (MFUNCTION-CALL $USIN1 $N))))
  46
  47 (DEFPROP $UCOS T TRANSLATED)
  48 (ADD2LNC (QUOTE $UCOS) $PROPS)
  49 (DEFMTRFUN ($UCOS $ANY MDEFINE NIL NIL) ($N) NIL (MUL* (SIMPLIFY (LIST (QUOTE (%SIGNUM)) ((LAMBDA (|tr-gensym~1|) (UNWIND-PROTECT (PROGN (NUMERSET (QUOTE $NUMER) |tr-gensym~1|) ((LAMBDA ($NUMER) NIL (SIMPLIFY (LIST (QUOTE (%COS)) (DIV (MUL* $N (QUOTE $%PI)) 10.)))) |tr-gensym~1|)) (NUMERSET (QUOTE $NUMER) (TRD-MSYMEVAL $NUMER (QUOTE $NUMER))))) T))) (SIMPLIFY (MFUNCTION-CALL $UCOS1 $N))))
  50
  51 (DEFPROP $USIN1 T TRANSLATED)
  52 (ADD2LNC (QUOTE $USIN1) $PROPS)
  53 (DEFMTRFUN ($USIN1 $ANY MDEFINE NIL NIL) ($N) NIL ((LAMBDA ($REM) NIL (COND ((OR (LIKE $REM 1.) (LIKE $REM 9.)) (DIV (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) -1.) 4.)) ((OR (LIKE $REM 2.) (LIKE $REM 8.)) (DIV (MUL* (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) -1.) (SIMPLIFY (LIST (QUOTE (%SQRT)) (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 5.)))) (MUL* 4. (SIMPLIFY (LIST (QUOTE (%SQRT)) 2.))))) ((OR (LIKE $REM 3.) (LIKE $REM 7.)) (DIV (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 1.) 4.)) ((OR (LIKE $REM 4.) (LIKE $REM 6.)) (DIV (SIMPLIFY (LIST (QUOTE (%SQRT)) (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 5.))) (MUL* 2. (SIMPLIFY (LIST (QUOTE (%SQRT)) 2.))))))) (SIMPLIFY (LIST (QUOTE (MABS)) (SIMPLIFY ($REMAINDER $N 10.))))))
  54
  55 (DEFPROP $UCOS1 T TRANSLATED)
  56 (ADD2LNC (QUOTE $UCOS1) $PROPS)
  57 (DEFMTRFUN ($UCOS1 $ANY MDEFINE NIL NIL) ($N) NIL ((LAMBDA ($REM) NIL (COND ((OR (LIKE $REM 1.) (LIKE $REM 9.)) (DIV (SIMPLIFY (LIST (QUOTE (%SQRT)) (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 5.))) (MUL* 2. (SIMPLIFY (LIST (QUOTE (%SQRT)) 2.))))) ((OR (LIKE $REM 2.) (LIKE $REM 8.)) (DIV (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 1.) 4.)) ((OR (LIKE $REM 3.) (LIKE $REM 7.)) (DIV (MUL* (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) -1.) (SIMPLIFY (LIST (QUOTE (%SQRT)) (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) 5.)))) (MUL* 4. (SIMPLIFY (LIST (QUOTE (%SQRT)) 2.))))) ((OR (LIKE $REM 4.) (LIKE $REM 6.)) (DIV (ADD* (SIMPLIFY (LIST (QUOTE (%SQRT)) 5.)) -1.) 4.)))) (SIMPLIFY (LIST (QUOTE (MABS)) (SIMPLIFY ($REMAINDER $N 10.))))))
  58
  59 (MEVAL* (QUOTE (($MODEDECLARE) $N $ANY)))
  60 (MEVAL* (QUOTE (($DECLARE) $N $SPECIAL)))
  61 (DEF-MTRVAR $N (QUOTE $N))
  62 (ADD2LNC (QUOTE $N) $PROPS)
  63 (MDEFPROP $N ($INTEGERP) MATCHDECLARE)
  64
  65 (MDEFPROP $SINRULE1 %SIN RULEOF)
  66 (ADD2LNC (QUOTE $SINRULE1) $RULES)
  67 (MDEFPROP %SIN 2. RULENUM)
  68 (DEFUN $SINRULE1 (X ANS A3) (SETQ X (SIMP-%SIN X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0017 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %SIN)))) (RETURN X))) (SETQ G0017 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0018) (SETQ G0018 (KAR G0017)) (SETQ G0018 (DIV G0018 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0018 (DIV G0018 (QUOTE $%PI))) (COND (($INTEGERP G0018) (SETQ $N G0018)) ((MATCHERR))) (COND ((NTHKDR G0017 1.) (MATCHERR))) (RETURN (SIMPLIFY (MFUNCTION-CALL $USIN (TRD-MSYMEVAL $N (QUOTE $N)))))))) (RETURN (OR ANS (EQTEST X X)))))))
  69 (MDEFPROP $SINRULE1 ((MEQUAL) ((%SIN SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) (($USIN SIMP) $N)) $RULE)
  70 (MDEFPROP %SIN (SIMP-%SIN) OLDRULES)
  71 (DEFPROP %SIN $SINRULE1 OPERATORS)
  72 (MDEFPROP %SIN ($SINRULE1 SIMP-%SIN) OLDRULES)
  73
  74 (MDEFPROP $COSRULE1 %COS RULEOF)
  75 (ADD2LNC (QUOTE $COSRULE1) $RULES)
  76 (MDEFPROP %COS 2. RULENUM)
  77 (DEFUN $COSRULE1 (X ANS A3) (SETQ X (SIMP-%COS X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0019 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %COS)))) (RETURN X))) (SETQ G0019 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0020) (SETQ G0020 (KAR G0019)) (SETQ G0020 (DIV G0020 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0020 (DIV G0020 (QUOTE $%PI))) (COND (($INTEGERP G0020) (SETQ $N G0020)) ((MATCHERR))) (COND ((NTHKDR G0019 1.) (MATCHERR))) (RETURN (SIMPLIFY (MFUNCTION-CALL $UCOS (TRD-MSYMEVAL $N (QUOTE $N)))))))) (RETURN (OR ANS (EQTEST X X)))))))
  78 (MDEFPROP $COSRULE1 ((MEQUAL) ((%COS SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) (($UCOS SIMP) $N)) $RULE)
  79 (MDEFPROP %COS (SIMP-%COS) OLDRULES)
  80 (DEFPROP %COS $COSRULE1 OPERATORS)
  81 (MDEFPROP %COS ($COSRULE1 SIMP-%COS) OLDRULES)
  82
  83 (MDEFPROP $TANRULE1 %TAN RULEOF)
  84 (ADD2LNC (QUOTE $TANRULE1) $RULES)
  85 (MDEFPROP %TAN 2. RULENUM)
  86 (DEFUN $TANRULE1 (X ANS A3) (SETQ X (SIMP-%TAN X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0021 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %TAN)))) (RETURN X))) (SETQ G0021 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0022) (SETQ G0022 (KAR G0021)) (SETQ G0022 (DIV G0022 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0022 (DIV G0022 (QUOTE $%PI))) (COND (($INTEGERP G0022) (SETQ $N G0022)) ((MATCHERR))) (COND ((NTHKDR G0021 1.) (MATCHERR))) (RETURN (MUL* (POWER (SIMPLIFY (MFUNCTION-CALL $UCOS (TRD-MSYMEVAL $N (QUOTE $N)))) -1.) (SIMPLIFY (MFUNCTION-CALL $USIN (TRD-MSYMEVAL $N (QUOTE $N))))))))) (RETURN (OR ANS (EQTEST X X)))))))
  87 (MDEFPROP $TANRULE1 ((MEQUAL) ((%TAN SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) ((MTIMES SIMP) ((MEXPT SIMP) (($UCOS SIMP) $N) -1.) (($USIN SIMP) $N))) $RULE)
  88 (MDEFPROP %TAN (SIMP-%TAN) OLDRULES)
  89 (DEFPROP %TAN $TANRULE1 OPERATORS)
  90 (MDEFPROP %TAN ($TANRULE1 SIMP-%TAN) OLDRULES)
  91
  92 (MDEFPROP $COTRULE1 %COT RULEOF)
  93 (ADD2LNC (QUOTE $COTRULE1) $RULES)
  94 (MDEFPROP %COT 2. RULENUM)
  95 (DEFUN $COTRULE1 (X ANS A3) (SETQ X (SIMP-%COT X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0023 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %COT)))) (RETURN X))) (SETQ G0023 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0024) (SETQ G0024 (KAR G0023)) (SETQ G0024 (DIV G0024 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0024 (DIV G0024 (QUOTE $%PI))) (COND (($INTEGERP G0024) (SETQ $N G0024)) ((MATCHERR))) (COND ((NTHKDR G0023 1.) (MATCHERR))) (RETURN (MUL* (SIMPLIFY (MFUNCTION-CALL $UCOS (TRD-MSYMEVAL $N (QUOTE $N)))) (POWER (SIMPLIFY (MFUNCTION-CALL $USIN (TRD-MSYMEVAL $N (QUOTE $N)))) -1.)))))) (RETURN (OR ANS (EQTEST X X)))))))
  96 (MDEFPROP $COTRULE1 ((MEQUAL) ((%COT SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) ((MTIMES SIMP) (($UCOS SIMP) $N) ((MEXPT SIMP) (($USIN SIMP) $N) -1.))) $RULE)
  97 (MDEFPROP %COT (SIMP-%COT) OLDRULES)
  98 (DEFPROP %COT $COTRULE1 OPERATORS)
  99 (MDEFPROP %COT ($COTRULE1 SIMP-%COT) OLDRULES)
 100
 101 (MDEFPROP $SECRULE1 %SEC RULEOF)
 102 (ADD2LNC (QUOTE $SECRULE1) $RULES)
 103 (MDEFPROP %SEC 2. RULENUM)
 104 (DEFUN $SECRULE1 (X ANS A3) (SETQ X (SIMP-%SEC X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0025 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %SEC)))) (RETURN X))) (SETQ G0025 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0026) (SETQ G0026 (KAR G0025)) (SETQ G0026 (DIV G0026 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0026 (DIV G0026 (QUOTE $%PI))) (COND (($INTEGERP G0026) (SETQ $N G0026)) ((MATCHERR))) (COND ((NTHKDR G0025 1.) (MATCHERR))) (RETURN (POWER (SIMPLIFY (MFUNCTION-CALL $UCOS (TRD-MSYMEVAL $N (QUOTE $N)))) -1.))))) (RETURN (OR ANS (EQTEST X X)))))))
 105 (MDEFPROP $SECRULE1 ((MEQUAL) ((%SEC SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) ((MEXPT SIMP) (($UCOS SIMP) $N) -1.)) $RULE)
 106 (MDEFPROP %SEC (SIMP-%SEC) OLDRULES)
 107 (DEFPROP %SEC $SECRULE1 OPERATORS)
 108 (MDEFPROP %SEC ($SECRULE1 SIMP-%SEC) OLDRULES)
 109
 110 (MDEFPROP $CSCRULE1 %CSC RULEOF)
 111 (ADD2LNC (QUOTE $CSCRULE1) $RULES)
 112 (MDEFPROP %CSC 2. RULENUM)
 113 (DEFUN $CSCRULE1 (X ANS A3) (SETQ X (SIMP-%CSC X ANS A3)) (COND ((TRD-MSYMEVAL *AFTERFLAG (QUOTE *AFTERFLAG)) X) (T (PROG (G0027 *AFTERFLAG) (SETQ *AFTERFLAG T) (COND ((OR (ATOM X) (NOT (EQ (CAAR X) (QUOTE %CSC)))) (RETURN X))) (SETQ G0027 (CDR X)) (SETQ ANS (*CATCH (QUOTE MATCH) (PROG ($N G0028) (SETQ G0028 (KAR G0027)) (SETQ G0028 (DIV G0028 (QUOTE ((RAT SIMP) 1. 10.)))) (SETQ G0028 (DIV G0028 (QUOTE $%PI))) (COND (($INTEGERP G0028) (SETQ $N G0028)) ((MATCHERR))) (COND ((NTHKDR G0027 1.) (MATCHERR))) (RETURN (POWER (SIMPLIFY (MFUNCTION-CALL $USIN (TRD-MSYMEVAL $N (QUOTE $N)))) -1.))))) (RETURN (OR ANS (EQTEST X X)))))))
 114 (MDEFPROP $CSCRULE1 ((MEQUAL) ((%CSC SIMP) ((MTIMES SIMP) ((RAT SIMP) 1. 10.) $%PI $N)) ((MEXPT SIMP) (($USIN SIMP) $N) -1.)) $RULE)
 115 (MDEFPROP %CSC (SIMP-%CSC) OLDRULES)
 116 (DEFPROP %CSC $CSCRULE1 OPERATORS)
 117 (MDEFPROP %CSC ($CSCRULE1 SIMP-%CSC) OLDRULES)
 118
 119
 120 (compile-forms-to-compile-queue)
 121