src/rzmac.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 rzmac macro)
  14
  15 ;;;   *****************************************************************
  16 ;;;   ***** MACROS ******* ASSORTED MACROS FOR GENERAL REPRESENTATION *
  17 ;;;   *****************************************************************
  18
  19 (defmacro *bind* (bindings &body body)
  20   (nconc (list 'do (mapcar #'(lambda (q)
  21                                (cond ((atom q)
  22                                       (list q))
  23                                      ((eq (cadr q) '|<-|)
  24                                       (list (car q) (caddr q)))
  25                                      (t q)))
  26                            bindings)
  27                '(nil))
  28          (maplist #'(lambda (x)
  29                       (cond ((null (cdr x))
  30                              (cons 'return x))
  31                             ((car x))))
  32                   body)))
  33
  34 ;; Returns the negation of VALUE if PREDICATE is true.  Otherwise, just
  35 ;; returns VALUE.
  36
  37 (defmacro negate-if (predicate value &aux (temp (gensym)))
  38   `(let ((,temp ,predicate))
  39     (if ,temp
  40         (neg ,value)
  41         ,value)))
  42
  43 ;; Setq's the first variable to VALUE if SWITCH is true, and sets the second
  44 ;; variable otherwise.
  45
  46 (defmacro set-either (first-var second-var switch value &aux (temp (gensym)))
  47   `(let ((,temp ,value))
  48     (if ,switch
  49         (setq ,first-var ,temp)
  50         (setq ,second-var ,temp))))
  51
  52 ;; symbolic arithmetic macros
  53
  54 (defmacro m+ (&rest body) `(add* . ,body))
  55
  56 (defmacro m* (&rest body) `(mul* . ,body))
  57
  58 (defmacro m1+ (x) `(add* 1 ,x))
  59
  60 (defmacro m1- (x) `(add* -1 ,x))
  61
  62 (defmacro m// (a1 &optional (a2 nil 2args))
  63   (if 2args
  64       `(div* ,a1 ,a2)
  65       `(inv* ,a1)))
  66
  67 (defmacro m- (a1 &optional (a2 nil 2args))
  68   (if 2args
  69       `(sub* ,a1 ,a2)
  70       `(mul* -1 ,a1)))
  71
  72 (defmacro m^ (b e) `(power* ,b ,e))
  73
  74 (defmacro m+l (l) `(addn ,l nil))
  75
  76 (defmacro m*l (l) `(muln ,l nil))
  77
  78 (defmacro m+t (&rest body) `(add . ,body))
  79
  80 (defmacro m*t (&rest body) `(mul . ,body))
  81
  82 (defmacro m1+t (x) `(add 1 ,x))
  83
  84 (defmacro m1-t (x) `(add -1 ,x))
  85
  86 (defmacro m//t (a1 &optional (a2 nil 2args))
  87   (if 2args
  88       `(div ,a1 ,a2)
  89       `(inv ,a1)))
  90
  91 (defmacro m-t (a1 &optional (a2 nil 2args))
  92   (if 2args
  93       `(sub ,a1 ,a2)
  94       `(neg ,a1)))
  95
  96 (defmacro m^t (b e) `(power ,b ,e))
  97
  98 (defmacro m+lt (l) `(addn ,l ,t))
  99
 100 (defmacro m*lt (l) `(muln ,l ,t))