;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     The data in this file contains enhancments.                    ;;;;;
;;;                                                                    ;;;;;
;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
;;;     All rights reserved                                            ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "MAXIMA")
(macsyma-module trigo)

(LOAD-MACSYMA-MACROS MRGMAC)

(DECLARE-TOP (GENPREFIX TRI)
	 (SPECIAL VARLIST ERRORSW)
	 (FLONUM (TAN) (COT) (SEC) (CSC)
		 (ATAN2) (ATAN1) (ACOT)
		 (SINH) (COSH) (TANH) (COTH) (CSCH) (SECH)
		 (ASINH) (ACSCH)
		 (T//$ FLONUM FLONUM NOTYPE))
	 (*EXPR $BFLOAT TEVAL SIGNUM1 ZEROP1 ISLINEAR
		TIMESK ADDK MAXIMA-INTEGERP EVOD LOGARC MEVENP HALFANGLE COEFF))

(declare-top (SPLITFILE hyper))

(DEFMFUN SIMP-%SINH (FORM Y Z) 
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (SINH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) 0)))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL '$%I (CONS-EXP '%SIN (COEFF Y '$%I 1))))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ASINH (CAAR Y)) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%SINH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%SINH Y))
	((AND $HALFANGLES (HALFANGLE '%SINH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%SINH (NEG Y))))
	(T (EQTEST (LIST '(%SINH) Y) FORM))))

(DEFMFUN SIMP-%COSH (FORM Y Z) 
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (COSH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) 1)))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (CONS-EXP '%COS (COEFF Y '$%I 1)))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ACOSH (CAAR Y)) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%COSH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%COSH Y))
	((AND $HALFANGLES (HALFANGLE '%COSH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (CONS-EXP '%COSH (NEG Y)))
	(T (EQTEST (LIST '(%COSH) Y) FORM))))

(DEFMFUN SIMP-%TANH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (TANH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) 0)))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL '$%I (CONS-EXP '%TAN (COEFF Y '$%I 1))))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ATANH (SETQ Z (CAAR Y))) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%TANH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%TANH Y))
	((AND $HALFANGLES (HALFANGLE '%TANH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%TANH (NEG Y))))
	(T (EQTEST (LIST '(%TANH) Y) FORM))))

(DEFMFUN SIMP-%COTH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (COTH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) (DBZ-ERR1 'COTH))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%COTH (COEFF Y '$%I 1))))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ACOTH (CAAR Y)) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%COTH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%COTH Y))
	((AND $HALFANGLES (HALFANGLE '%COTH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%COTH (NEG Y))))
	(T (EQTEST (LIST '(%COTH) Y) FORM))))

(DEFMFUN SIMP-%CSCH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (CSCH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (COND ((ZEROP1 Y) (DBZ-ERR1 'CSCH)))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%CSC (COEFF Y '$%I 1))))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ACSCH (CAAR Y)) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%CSCH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%CSCH Y))
	((AND $HALFANGLES (HALFANGLE '%CSCH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%CSCH (NEG Y))))
	(T (EQTEST (LIST '(%CSCH) Y) FORM))))

(DEFMFUN SIMP-%SECH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (SECH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (ZEROP1 Y)) 1)
	((AND $%IARGS (MULTIPLEP Y '$%I)) (CONS-EXP '%SEC (COEFF Y '$%I 1)))
	((AND $TRIGINVERSES (NOT (ATOM Y)) (IF (EQ '%ASECH (CAAR Y)) (CADR Y))))
	((AND $TRIGEXPAND (TRIGEXPAND '%SECH Y)))
	($EXPONENTIALIZE (EXPONENTIALIZE '%SECH Y))
	((AND $HALFANGLES (HALFANGLE '%SECH Y)))
	((AND $TRIGSIGN (MMINUSP* Y)) (CONS-EXP '%SECH (NEG Y)))
	(T (EQTEST (LIST '(%SECH) Y) FORM))))

(declare-top (SPLITFILE ATRIG))

(DEFMFUN SIMP-%ASIN (FORM Y Z) 
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ASIN Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS 
	      (COND ((ZEROP1 Y) 0) ((EQUAL 1 Y) %PI//2) ((EQUAL -1 Y) (NEG %PI//2))
		    ((ALIKE1 Y 1//2) (MUL '((RAT SIMP) 1 6) '$%PI)))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL '$%I (CONS-EXP '%ASINH (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y)) (IF (EQ '%SIN (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ASIN Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ASIN (NEG Y))))
	(T (EQTEST (LIST '(%ASIN) Y) FORM))))

(DEFMFUN SIMP-%ACOS (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACOS Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS 
	      (COND ((ZEROP1 Y) %PI//2) ((EQUAL 1 Y) 0) ((EQUAL -1 Y) '$%PI)
		    ((ALIKE1 Y 1//2) (MUL '((RAT SIMP) 1 3) '$%PI)))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%COS (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACOS Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (SUB '$%PI (CONS-EXP '%ACOS (NEG Y))))
	(T (EQTEST (LIST '(%ACOS) Y) FORM))))

(DEFMFUN SIMP-%ACOT (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACOT Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS
	      (COND ((ZEROP1 Y) %PI//2) ((EQUAL 1 Y) %PI//4) ((EQUAL -1 Y) (NEG %PI//4)))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%ACOTH (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%COT (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACOT Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ACOT (NEG Y))))
	(T (EQTEST (LIST '(%ACOT) Y) FORM))))

(DEFMFUN SIMP-%ACSC (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACSC Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS
	      (COND ((EQUAL 1 Y) %PI//2) ((EQUAL -1 Y) (NEG %PI//2)))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%ACSCH (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%CSC (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACSC Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ACSC (NEG Y))))
	(T (EQTEST (LIST '(%ACSC) Y) FORM))))

(DEFMFUN SIMP-%ASEC (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ASEC Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS 
	      (COND ((EQUAL 1 Y) 0) ((EQUAL -1 Y) '$%PI))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%SEC (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ASEC Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (SUB '$%PI (CONS-EXP '%ASEC (NEG Y))))
	(T (EQTEST (LIST '(%ASEC) Y) FORM))))

(declare-top (SPLITFILE AHYPER))

(DEFMFUN SIMP-%ASINH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ASINH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) Y)))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL '$%I (CONS-EXP '%ASIN (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%SINH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ASINH Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ASINH (NEG Y))))
	(T (EQTEST (LIST '(%ASINH) Y) FORM))))

(DEFMFUN SIMP-%ACOSH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACOSH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (EQUAL Y 1) 0)))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%COSH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACOSH Y))
	(T (EQTEST (LIST '(%ACOSH) Y) FORM))))

(DEFMFUN SIMP-%ATANH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ATANH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (COND ((ZEROP1 Y) 0)
			     ((OR (EQUAL Y 1) (EQUAL Y -1)) (DBZ-ERR1 'ATANH)))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL '$%I (CONS-EXP '%ATAN (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%TANH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ATANH Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ATANH (NEG Y))))
	(T (EQTEST (LIST '(%ATANH) Y) FORM))))

(DEFMFUN SIMP-%ACOTH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACOTH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (OR (EQUAL Y 1) (EQUAL Y -1)) (DBZ-ERR1 'ACOTH))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%ACOT (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%COTH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACOTH Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ACOTH (NEG Y))))
	(T (EQTEST (LIST '(%ACOTH) Y) FORM))))

(DEFMFUN SIMP-%ACSCH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ACSCH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (IF (ZEROP1 Y) (DBZ-ERR1 'ACSCH))))
	((AND $%IARGS (MULTIPLEP Y '$%I)) (MUL -1 '$%I (CONS-EXP '%ACSC (COEFF Y '$%I 1))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%CSCH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ACSCH Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (NEG (CONS-EXP '%ACSCH (NEG Y))))
	(T (EQTEST (LIST '(%ACSCH) Y) FORM))))

(DEFMFUN SIMP-%ASECH (FORM Y Z)
  (ONEARGCHECK FORM)
  (SETQ Y (SIMPCHECK (CADR FORM) Z))
  (COND ((OR (FLOATP Y) (AND $NUMER (INTEGERP Y))) (ASECH Y))
	(($BFLOATP Y) ($BFLOAT FORM))
	((AND $%PIARGS (COND ((EQUAL Y 1) 0)
			     ((ZEROP1 Y) (DBZ-ERR1 'ASECH)))))
	((AND (EQ $TRIGINVERSES '$ALL) (NOT (ATOM Y))
	      (IF (EQ '%SECH (CAAR Y)) (CADR Y))))
	($LOGARC (LOGARC '%ASECH Y))
	((AND $TRIGSIGN (MMINUSP* Y)) (CONS-EXP '%ASECH (NEG Y)))
	(T (EQTEST (LIST '(%ASECH) Y) FORM))))

(declare-top (SPLITFILE TRIGEX) (SPECIAL $TRIGEXPANDPLUS $TRIGEXPANDTIMES))

(DEFMFUN $TRIGEXPAND (E)
  (COND ((ATOM E) E)
	((SPECREPP E) ($TRIGEXPAND (SPECDISREP E)))
	((TRIGEXPAND (CAAR E) (CADR E)))
	(T (RECUR-APPLY #'$TRIGEXPAND E))))

(DEFMFUN TRIGEXPAND (OP ARG)
  (COND ((ATOM ARG) NIL)
	((AND $TRIGEXPANDPLUS (EQ 'MPLUS (CAAR ARG)))
	 (COND ((EQ '%SIN OP) (SIN\COS-PLUS (CDR ARG) 1 '%SIN '%COS -1))
	       ((EQ '%COS OP) (SIN\COS-PLUS (CDR ARG) 0 '%SIN '%COS -1))
	       ((EQ '%TAN OP) (TAN-PLUS (CDR ARG) '%TAN -1))
	       ((EQ '%COT OP) (COT-PLUS (CDR ARG) '%COT -1))
	       ((EQ '%CSC OP) (CSC\SEC-PLUS (CDR ARG) 1 '%CSC '%SEC -1))
	       ((EQ '%SEC OP) (CSC\SEC-PLUS (CDR ARG) 0 '%CSC '%SEC -1))
	       ((EQ '%SINH OP) (SIN\COS-PLUS (CDR ARG) 1 '%SINH '%COSH 1))
	       ((EQ '%COSH OP) (SIN\COS-PLUS (CDR ARG) 0 '%SINH '%COSH 1))
	       ((EQ '%TANH OP) (TAN-PLUS (CDR ARG) '%TANH 1))
	       ((EQ '%COTH OP) (COT-PLUS (CDR ARG) '%COTH 1))
	       ((EQ '%CSCH OP) (CSC\SEC-PLUS (CDR ARG) 1 '%CSCH '%SECH 1))
	       ((EQ '%SECH OP) (CSC\SEC-PLUS (CDR ARG) 0 '%CSCH '%SECH 1))))
	((AND $TRIGEXPANDTIMES (EQ 'MTIMES (CAAR ARG)) (EQ (ml-typep (CADR ARG)) 'fixnum))
	 (COND ((EQ '%SIN OP) (SIN\COS-TIMES (CDDR ARG) 1 (CADR ARG) '%SIN '%COS -1))
	       ((EQ '%COS OP) (SIN\COS-TIMES (CDDR ARG) 0 (CADR ARG) '%SIN '%COS -1))
	       ((EQ '%TAN OP) (TAN-TIMES (CDDR ARG) (CADR ARG) '%TAN -1))
	       ((EQ '%COT OP) (COT-TIMES (CDDR ARG) (CADR ARG) '%COT -1))
	       ((EQ '%CSC OP) (CSC\SEC-TIMES (CDDR ARG) 1 (CADR ARG) '%CSC '%SEC -1))
	       ((EQ '%SEC OP) (CSC\SEC-TIMES (CDDR ARG) 0 (CADR ARG) '%CSC '%SEC -1))
	       ((EQ '%SINH OP) (SIN\COS-TIMES (CDDR ARG) 1 (CADR ARG) '%SINH '%COSH 1))
	       ((EQ '%COSH OP) (SIN\COS-TIMES (CDDR ARG) 0 (CADR ARG) '%SINH '%COSH 1))
	       ((EQ '%TANH OP) (TAN-TIMES (CDDR ARG) (CADR ARG) '%TANH 1))
	       ((EQ '%COTH OP) (COT-TIMES (CDDR ARG) (CADR ARG) '%COTH 1))
	       ((EQ '%CSCH OP) (CSC\SEC-TIMES (CDDR ARG) 1 (CADR ARG) '%CSCH '%SECH 1))
	       ((EQ '%SECH OP) (CSC\SEC-TIMES (CDDR ARG) 0 (CADR ARG) '%CSCH '%SECH 1))))))


(DEFUN SIN\COS-PLUS (L N F1 F2 FLAG)
  (DO ((I N (f+ 2 I)) (LEN (LENGTH L)) (SIGN 1 (f* FLAG SIGN)) (RESULT))
      ((> I LEN) (SIMPLIFY (CONS '(MPLUS) RESULT)))
      (SETQ RESULT (MPC (COND ((MINUSP SIGN) '(-1 (MTIMES))) (T '((MTIMES)))) L RESULT F1 F2 LEN I))))

(DEFUN TAN-PLUS (L F FLAG) 
  (DO ((I 1 (f+ 2 I)) (SIGN 1 (f* FLAG SIGN)) (LEN (LENGTH L)) (NUM) (DEN (LIST 1)))
   ((> I LEN) (DIV* (CONS '(MPLUS) NUM) (CONS '(MPLUS) DEN)))
   (SETQ NUM (MPC1 (LIST SIGN '(MTIMES)) L NUM F LEN I)
	 DEN (COND ((= LEN I) DEN)
		   (T (MPC1 (LIST (f* FLAG SIGN) '(MTIMES)) L DEN F LEN (f1+ I)))))))

(DEFUN COT-PLUS (L F FLAG)
  (DO ((I (LENGTH L) (f- I 2)) (LEN (LENGTH L)) (SIGN 1 (f* FLAG SIGN)) (NUM) (DEN))
   ((< I 0) (DIV* (CONS '(MPLUS) NUM) (CONS '(MPLUS) DEN)))
   (SETQ NUM (MPC1 (LIST SIGN '(MTIMES)) L NUM F LEN I)
	 DEN (COND ((= 0 I) DEN)
		   (T (MPC1 (LIST SIGN '(MTIMES)) L DEN F LEN (f1- I)))))))

(DEFUN CSC\SEC-PLUS (L N F1 F2 FLAG)
  (DIV* (DO ((L L (CDR L)) (RESULT)) ((NULL L) (CONS '(MTIMES) RESULT))
		   (SETQ RESULT (CONS (CONS-EXP F1 (CAR L)) (CONS (CONS-EXP F2 (CAR L)) RESULT))))
	       (SIN\COS-PLUS L N F1 F2 FLAG)))

(DEFUN SIN\COS-TIMES (L M N F1 F2 FLAG)
;; Assume m,n < 2^17, but Binom may become big
;; Flag is 1 or -1
  (SETQ F1 (CONS-EXP F1 (CONS '(MTIMES) L)) F2 (CONS-EXP F2 (CONS '(MTIMES) L)))
  (DO ((I M (f+ 2 I)) (END (ABS N)) (RESULT)
       (BINOM (COND ((= 0 M) 1) (T (ABS N))) (quotient (times (f* FLAG (f- END I 1) (f- END I)) BINOM) (f* (f+ 2 I) (f1+ I)))))
      ((> I END) (SETQ RESULT (SIMPLIFY (CONS '(MPLUS) RESULT)))
		 (COND ((AND (= 1 M) (MINUSP N)) (NEG RESULT)) (T RESULT)))
      (SETQ RESULT (CONS (MUL BINOM (POWER F1 I) (POWER F2 (f- END I))) RESULT))))

(DEFUN TAN-TIMES (L N F FLAG)
  (SETQ F (CONS-EXP F (CONS '(MTIMES) L)))
  (DO ((I 1 (f+ 2 I)) (END (ABS N)) (NUM) (DEN (LIST 1))
       (BINOM (ABS N) (quotient (times (f- END I 1) BINOM) (f+ 2 I))))
      ((> I END) (SETQ NUM (DIV* (CONS '(MPLUS) NUM) (CONS '(MPLUS) DEN)))
		 (COND ((MINUSP N) (NEG NUM)) (T NUM)))
      (SETQ NUM (CONS (MUL BINOM (POWER F I)) NUM) 
	    DEN (COND ((= END I) DEN)
		      (T (CONS (MUL (SETQ BINOM (// (f* FLAG (f- END I) BINOM) (f1+ I)))
				    (POWER F (f1+ I)))
			       DEN))))))

(DEFUN COT-TIMES (L N F FLAG)
  (SETQ F (CONS-EXP F (CONS '(MTIMES) L)))
  (DO ((I (ABS N) (f- I 2)) (END (ABS N)) (NUM) (DEN)
       (BINOM 1 (// (f* FLAG (f1- I) BINOM) (f- END I -2))))
      ((< I 0) (SETQ NUM (DIV* (CONS '(MPLUS) NUM) (CONS '(MPLUS) DEN)))
		(IF (MINUSP N) (NEG NUM) NUM))
      (SETQ NUM (CONS (MUL BINOM (POWER F I)) NUM)
	    DEN (IF (= 0 I) DEN
		    (CONS (MUL (SETQ BINOM (// (f* I BINOM) (f- END I -1))) (POWER F (f1- I))) DEN)))))

(DEFUN CSC\SEC-TIMES (L M N F1 F2 FLAG)
  (DIV* (MUL (POWER (CONS-EXP F1 (CONS '(MTIMES) L)) (ABS N))
			 (POWER (CONS-EXP F2 (CONS '(MTIMES) L)) (ABS N)))
	       (SIN\COS-TIMES L M N F1 F2 FLAG)))

(DEFUN MPC (DL UL RESULT F1 F2 DI UI) 
  (COND ((= 0 UI)
	 (CONS (RECONC DL (MAPCAR #'(LAMBDA (L) (CONS-EXP F2 L)) UL))
	       RESULT))
	((= DI UI)
	 (CONS (RECONC DL (MAPCAR #'(LAMBDA (L) (CONS-EXP F1 L)) UL))
	       RESULT))
	(T (MPC (CONS (CONS-EXP F1 (CAR UL)) DL) (CDR UL)
		(MPC (CONS (CONS-EXP F2 (CAR UL)) DL)
		     (CDR UL) RESULT F1 F2 (f1- DI) UI) F1 F2
		(f1- DI) (f1- UI)))))

(DEFUN MPC1 (DL UL RESULT F DI UI) 
  (COND ((= 0 UI) (CONS (REVERSE DL) RESULT))
	((= DI UI)
	 (CONS (RECONC DL (MAPCAR #'(LAMBDA (L) (CONS-EXP F L)) UL)) RESULT))
	(T (MPC1 (CONS (CONS-EXP F (CAR UL)) DL) (CDR UL)
		 (MPC1 DL (CDR UL) RESULT F (f1- DI) UI) F
		 (f1- DI) (f1- UI)))))

;; Local Modes:
;; Mode: LISP
;; Comment Col: 40
;; End: