8
8
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
9
9
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
12
(macsyma-module ratmac macro)
14
14
;; Macros for manipulating rational functions.
16
(DEFMACRO PCOEFP (E) `(ATOM ,E))
21
(DEFMACRO PZEROP (X) `(SIGNP E ,X)) ;TRUE FOR 0 OR 0.0
16
(defmacro pcoefp (e) `(atom ,e))
21
(defmacro pzerop (x) `(signp e ,x)) ;TRUE FOR 0 OR 0.0
22
22
;;;(DEFMACRO PZEROP (X) `(LET ((gg1032 ,X)) (AND (NUMBERP gg1032) (ZEROP gg1032))))
24
24
(proclaim '(inline pzerop))
26
26
(defun pzerop (x) (if (fixnump x) (zerop (the fixnum x))
28
(and (floatp x) (zerop x)))))
32
(DEFMACRO PTZEROP (TERMS) `(NULL ,TERMS)) ;for poly terms
33
(DEFMACRO PTZERO () '())
36
(DEFMACRO CZEROP (C) `(SIGNP E ,C))
28
(and (floatp x) (zerop x)))))
32
(defmacro ptzerop (terms) `(null ,terms)) ;for poly terms
33
(defmacro ptzero () '())
36
(defmacro czerop (c) `(signp e ,c))
38
38
(defmacro czerop (c) `(pzerop ,c))
40
(DEFMACRO CMINUS (C) `(MINUS ,C))
41
(DEFMACRO CMINUSP (C) `(MINUSP ,C))
42
(DEFMACRO CDERIVATIVE (ign ign1)ign ign1 0)
40
(defmacro cminus (c) `(minus ,c))
41
(defmacro cminusp (c) `(minusp ,c))
42
(defmacro cderivative (ign ign1)ign ign1 0)
44
44
;; Similar to REMOVE on the Lisp Machine
45
(DEFMACRO DELET (ITEM LLIST) `(ZL-DELETE ,ITEM (COPY-TOP-LEVEL ,LLIST )))
45
(defmacro delet (item llist) `(zl-delete ,item (copy-top-level ,llist )))
47
47
;; the rational function package uses GENSYM's to represent variables.
48
48
;; The PDP-10 implementation used to use the PRINTNAME of the gensym
51
51
;; to use the property list, as thats a lot cheaper than creating a value
52
52
;; cell. Actually, better to use the PACKAGE slot, a kludge is a kludge right?
54
(DEFMACRO VALGET (ITEM)
55
#+NIL `(GET ,ITEM 'GENSYMVAL)
56
#-NIL `(SYMBOL-VALUE ,ITEM))
58
(DEFMACRO VALPUT (ITEM VAL)
59
`(SETF (VALGET ,ITEM) ,VAL))
54
(defmacro valget (item)
55
#+nil `(get ,item 'gensymval)
56
#-nil `(symbol-value ,item))
58
(defmacro valput (item val)
59
`(setf (valget ,item) ,val))
61
;; A historical note from Richard Fateman, on the maxima list,
64
;; "The name pointerp comes from the original hack when we wanted a
65
;; bunch of atoms that could be ordered fast, we just generated, say,
66
;; 10 gensyms. Then we sorted them by the addresses of the symbols in
67
;; memory. Then we associated them with x,y,z,.... This meant that
68
;; pointergp was one or two instructions on a PDP-10, in assembler."
70
;; "That version of pointergp turned out to be more trouble than it was
71
;; worth because we sometimes had to interpolate between two gensym
72
;; "addresses" and to do that we had to kind of renumber too much of
73
;; the universe. Or maybe we just weren't clever enough to do it
74
;; without introducing bugs."
76
;; Richard Fateman also says pointergp needs to be fast because it's
77
;; called a lot. So if you get an error from pointergp, it's probably
78
;; because someone forgot to initialize things correctly.
61
79
(proclaim '(inline pointergp))
62
(DEFun POINTERGP (A B) (f> (valget A) (VALGET B)))
80
(defun pointergp (a b)
81
(f> (valget a) (valget b)))
64
;(macro ALGV (L) `(AND $ALGEBRAIC (GET ,(CADR L) 'TELLRAT)))
83
;;(macro ALGV (L) `(AND $ALGEBRAIC (GET ,(CADR L) 'TELLRAT)))
66
85
`(and $algebraic (get ,v 'tellrat)))
69
(DEFMACRO EQN (&REST L) `(EQUAL . ,L))
71
(DEFMACRO RZERO () ''(0 . 1))
72
(DEFMACRO RZEROP (A) `(PZEROP (CAR ,A)))
74
(defmacro PRIMPART (p) `(cadr (oldcontent ,p)))
88
(defmacro eqn (&rest l) `(equal . ,l))
90
(defmacro rzero () ''(0 . 1))
91
(defmacro rzerop (a) `(pzerop (car ,a)))
93
(defmacro primpart (p) `(cadr (oldcontent ,p)))
78
97
(defmacro make-poly (var &optional (terms-or-e nil options?) (c nil e-c?)
80
99
(cond ((null options?) `(cons ,var '(1 1)))
81
100
((null e-c?) `(psimp ,var ,terms-or-e))
82
101
((null terms?) `(list ,var ,terms-or-e ,c))
85
104
;;Poly selector functions
87
(defmacro P-VAR (p) `(car ,p))
89
(defmacro P-TERMS (p) `(cdr ,p))
91
(defmacro P-LC (p) `(caddr ,p)) ;leading coefficient
93
(defmacro P-LE (p) `(cadr ,p))
95
(defmacro P-RED (p) `(cdddr ,p))
106
(defmacro p-var (p) `(car ,p))
108
(defmacro p-terms (p) `(cdr ,p))
110
(defmacro p-lc (p) `(caddr ,p)) ;leading coefficient
112
(defmacro p-le (p) `(cadr ,p))
114
(defmacro p-red (p) `(cdddr ,p))
97
116
;;poly terms selectors
99
(defmacro PT-LC (terms) `(cadr ,terms))
101
(defmacro PT-LE (terms) `(car ,terms))
103
(defmacro PT-RED (terms) `(cddr ,terms))
118
(defmacro pt-lc (terms) `(cadr ,terms))
120
(defmacro pt-le (terms) `(car ,terms))
122
(defmacro pt-red (terms) `(cddr ,terms))
105
124
;; Taken from SININT and RISCH. Somebody document these please.
109
(T `(RATPL ,R (R+ ,@L)))))
113
(T `(RATTI ,R (R* ,@L) T))))
116
(COND ((NULL L) `(RATMINUS (RATFIX ,R)))
117
(T `(RATDIF (RATFIX ,R) (R+ ,@L)))))
128
(t `(ratpl ,r (r+ ,@l)))))
132
(t `(ratti ,r (r* ,@l) t))))
135
(cond ((null l) `(ratminus (ratfix ,r)))
136
(t `(ratdif (ratfix ,r) (r+ ,@l)))))
120
139
(defvar $ratvarswitch t)
122
;(defvar *rational-function-files* '(
141
;;(defvar *rational-function-files* '(
added
removed
src/ratmac.lisp
