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