1;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;;     The data in this file contains enhancments.                    ;;;;;
4;;;                                                                    ;;;;;
5;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
6;;;     All rights reserved                                            ;;;;;
7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10
11(in-package :maxima)
12
13(macsyma-module mopers macro)
14
15;; This file is the compile-time half of the OPERS package, an interface to the
16;; Maxima general representaton simplifier.  When new expressions are being
17;; created, the macros in this file or the functions in NOPERS should be called
18;; rather than the entrypoints in SIMP such as SIMPLIFYA or SIMPLUS.
19
20;; The basic functions are ADD, SUB, MUL, DIV, POWER, NCMUL, NCPOWER, INV.
21;; Each of these functions assume that their arguments are simplified.  Some
22;; functions will have a "*" adjoined to the end of the name (as in ADD*).
23;; These do not assume that their arguments are simplified.  The above
24;; functions are the only entrypoints to this package.
25
26;; The functions ADD2, MUL2, and MUL3 are for use internal to this package
27;; and should not be called externally.
28
29;; I have added the macro DEFGRAD as an interface to the $DERIVATIVE function
30;; for use by macsyma programers who want to do a bit of lisp programming. -GJC
31
32(defmacro =0 (x) `(equal ,x 0))
33(defmacro =1 (x) `(equal ,x 1))
34
35;; Addition -- call ADD with simplified operands,
36;;             ADD* with unsimplified operands.
37
38(defun add (&rest terms)
39  (if (= (length terms) 2)
40      (apply #'add2 terms)
41      (apply #'addn `(,terms t))))
42
43(define-compiler-macro add (&rest terms)
44  (if (= (length terms) 2)
45      `(add2 ,@terms)
46      `(addn (list ,@terms) t)))
47
48(defun add* (&rest terms)
49  (if (= (length terms) 2)
50      (apply #'add2* terms)
51      (apply #'addn `(,terms nil))))
52
53(define-compiler-macro add* (&rest terms)
54  (if (= (length terms) 2)
55      `(add2* ,@terms)
56      `(addn (list ,@terms) nil)))
57
58;; Multiplication -- call MUL or NCMUL with simplified operands,
59;;                        MUL* or NCMUL* with unsimplified operands.
60
61(defun mul (&rest factors)
62  (cond ((= (length factors) 2) (apply #'mul2 factors))
63        ((= (length factors) 3) (apply #'mul3 factors))
64        (t (apply #'muln `(,factors t)))))
65
66(define-compiler-macro mul (&rest factors)
67  (cond ((= (length factors) 2) `(mul2 ,@factors))
68	((= (length factors) 3) `(mul3 ,@factors))
69	(t `(muln (list ,@factors) t))))
70
71(defun mul* (&rest factors)
72  (if (= (length factors) 2)
73      (apply #'mul2* factors)
74      (apply #'muln `(,factors nil))))
75
76(define-compiler-macro mul* (&rest factors)
77  (if (= (length factors) 2)
78      `(mul2* ,@factors)
79      `(muln (list ,@factors) nil)))
80
81(defmacro inv (x)
82  `(power ,x -1))
83
84(defmacro inv* (x)
85  `(power* ,x -1))
86
87(defmacro ncmul (&rest factors)
88  (if (= (length factors) 2)
89      `(ncmul2 ,@factors)
90      `(ncmuln (list ,@factors) t)))
91
92;; (TAKE '(%TAN) X) = tan(x)
93;; This syntax really loses.  Not only does this syntax lose, but this macro
94;; has to look like a subr.  Otherwise, the definition would look like
95;; (DEFMACRO TAKE ((NIL (OPERATOR)) . ARGS) ...)
96
97;; (TAKE A B) --> (SIMPLIFYA (LIST A B) T)
98;; (TAKE '(%SIN) A) --> (SIMP-%SIN (LIST '(%SIN) A) 1 T)
99
100(defmacro take (operator &rest args)
101; Cutting out the code which bypasses the simplifier.
102;  (let ((simplifier (and (not (atom operator))
103;			 (eq (car operator) 'quote)
104;			 (cdr (assoc (caadr operator) '((%atan  . simp-%atan)
105;							(%tan   . simp-%tan)
106;							(%log   . simpln)
107;							(mabs   . simpabs)
108;							(%sin   . simp-%sin)
109;							(%cos   . simp-%cos)
110;							($atan2 . simpatan2)) :test #'eq)))))
111;    (if simplifier
112;	`(,simplifier (list ,operator ,@args) 1 t)
113	`(simplifya (list ,operator ,@args) t))
114
115;; take* does not assume that the arguments are simplified.
116(defmacro take* (operator &rest args)
117  `(simplifya (list ,operator ,@args) nil))
118
119(declaim (inline simplify))
120(defun simplify (x)
121  (simplifya x nil))
122
123;; A hand-made DEFSTRUCT for dealing with the Maxima MDO structure.
124;; Used in GRAM, etc. for storing/retrieving from DO structures.
125
126(defmacro make-mdo () '(list (list 'mdo) nil nil nil nil nil nil nil))
127
128(defmacro mdo-op (x)     `(car (car ,x)))
129
130(defmacro mdo-for (x)    `(second ,x))
131(defmacro mdo-from (x)   `(third ,x))
132(defmacro mdo-step (x)   `(fourth ,x))
133(defmacro mdo-next (x)   `(fifth ,x))
134(defmacro mdo-thru (x)   `(sixth ,x))
135(defmacro mdo-unless (x) `(seventh ,x))
136(defmacro mdo-body (x)	 `(eighth ,x))
137
138(defmacro defgrad (name arguments &body body)
139  `(defprop ,name (,arguments ,@body) grad))
140