More documentation and comment out debugging print.
[maxima.git] / src / rzmac.lisp
blobdf75f3815cf8e61e53afb2ff2b886e7abe5b1e71
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package :maxima)
13 (macsyma-module rzmac macro)
15 ;;; *****************************************************************
16 ;;; ***** MACROS ******* ASSORTED MACROS FOR GENERAL REPRESENTATION *
17 ;;; *****************************************************************
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)))
34 ;; Returns the negation of VALUE if PREDICATE is true. Otherwise, just
35 ;; returns VALUE.
37 (defmacro negate-if (predicate value &aux (temp (gensym)))
38 `(let ((,temp ,predicate))
39 (if ,temp
40 (neg ,value)
41 ,value)))
43 ;; Setq's the first variable to VALUE if SWITCH is true, and sets the second
44 ;; variable otherwise.
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))))
52 ;; symbolic arithmetic macros
54 (defmacro m+ (&rest body) `(add* . ,body))
56 (defmacro m* (&rest body) `(mul* . ,body))
58 (defmacro m1+ (x) `(add* 1 ,x))
60 (defmacro m1- (x) `(add* -1 ,x))
62 (defmacro m// (a1 &optional (a2 nil 2args))
63 (if 2args
64 `(div* ,a1 ,a2)
65 `(inv* ,a1)))
67 (defmacro m- (a1 &optional (a2 nil 2args))
68 (if 2args
69 `(sub* ,a1 ,a2)
70 `(mul* -1 ,a1)))
72 (defmacro m^ (b e) `(power* ,b ,e))
74 (defmacro m+l (l) `(addn ,l nil))
76 (defmacro m*l (l) `(muln ,l nil))
78 (defmacro m+t (&rest body) `(add . ,body))
80 (defmacro m*t (&rest body) `(mul . ,body))
82 (defmacro m1+t (x) `(add 1 ,x))
84 (defmacro m1-t (x) `(add -1 ,x))
86 (defmacro m//t (a1 &optional (a2 nil 2args))
87 (if 2args
88 `(div ,a1 ,a2)
89 `(inv ,a1)))
91 (defmacro m-t (a1 &optional (a2 nil 2args))
92 (if 2args
93 `(sub ,a1 ,a2)
94 `(neg ,a1)))
96 (defmacro m^t (b e) `(power ,b ,e))
98 (defmacro m+lt (l) `(addn ,l ,t))
100 (defmacro m*lt (l) `(muln ,l ,t))