src/mopers.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancements.                   ;;;;;
   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 programmers 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 ;;
  94 ;; Stavros says it's named take:
  95 ;;   "Take as in 'take the sine of ...'.  call or apply might imply
  96 ;;   it's a function call, which it isn't."
  97 ;;
  98 ;; This syntax really loses.  Not only does this syntax lose, but this macro
  99 ;; has to look like a subr.  Otherwise, the definition would look like
 100 ;; (DEFMACRO TAKE ((NIL (OPERATOR)) . ARGS) ...)
 101
 102 ;; (TAKE A B) --> (SIMPLIFYA (LIST A B) T)
 103 ;; (TAKE '(%SIN) A) --> (SIMP-%SIN (LIST '(%SIN) A) 1 T)
 104
 105 (defmacro take (operator &rest args)
 106         `(simplifya (list ,operator ,@args) t))
 107
 108 ;; take* does not assume that the arguments are simplified.
 109 (defmacro take* (operator &rest args)
 110   `(simplifya (list ,operator ,@args) nil))
 111
 112 ;; Like TAKE, but you only need to specify then name.  So
 113 ;;
 114 ;; (ftake name x y) => (take '(name) x y)
 115 ;;
 116 ;; The name should be the verb form, like %foo.
 117 (defmacro ftake (name &rest args)
 118   `(simplifya (list (list ,name) ,@args)
 119               t))
 120
 121 (defmacro ftake* (name &rest args)
 122   `(simplifya (list (list ,name) ,@args)
 123               nil))
 124
 125 ;; Apply a function f to a list of its arguments 'args' and simplify the result. Assume
 126 ;; that the list args is simplified.
 127 (defmacro fapply (f args)
 128         `(simplifya (cons (list ,f) ,args) t))
 129
 130 ;; Same as fapply, but don't assume that the list of arguments is simplified.
 131 (defmacro fapply* (f args)
 132         `(simplifya (cons (list ,f) ,args) nil))
 133
 134 (declaim (inline simplify))
 135 (defun simplify (x)
 136   (simplifya x nil))
 137
 138 ;; A hand-made DEFSTRUCT for dealing with the Maxima MDO structure.
 139 ;; Used in GRAM, etc. for storing/retrieving from DO structures.
 140
 141 (defmacro make-mdo () '(list (list 'mdo) nil nil nil nil nil nil nil))
 142
 143 (defmacro mdo-op (x)     `(car (car ,x)))
 144
 145 (defmacro mdo-for (x)    `(second ,x))
 146 (defmacro mdo-from (x)   `(third ,x))
 147 (defmacro mdo-step (x)   `(fourth ,x))
 148 (defmacro mdo-next (x)   `(fifth ,x))
 149 (defmacro mdo-thru (x)   `(sixth ,x))
 150 (defmacro mdo-unless (x) `(seventh ,x))
 151 (defmacro mdo-body (x)   `(eighth ,x))
 152
 153 (defmacro defgrad (name arguments &body body)
 154   `(defprop ,name (,arguments ,@body) grad))