/usr/share/maxima/5.41.0/src/maxmac.lisp is in maxima-src 5.41.0-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The data in this file contains enhancments. ;;;;;
;;; ;;;;;
;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
;;; All rights reserved ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (c) Copyright 1976, 1983 Massachusetts Institute of Technology ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :maxima)
(macsyma-module maxmac macro)
;; This file contains miscellaneous macros used in Macsyma source files.
;; General purpose macros which are used in Lisp code, but not widely enough
;; accepted to be a part of Lisp systems.
;; 'ttyoff' is a system independent way of expressing the Maclisp ^W.
(defvar ttyoff '^w)
;; Like PUSH, but works at the other end.
(defmacro tuchus (list object)
`(setf ,list (nconc ,list (ncons ,object))))
;; The following macros pertain only to Macsyma.
;; Except on the Lisp Machine, load the specified macro files.
;; On the Lisp Machine, the DEFSYSTEM facility is used for loading
;; macro files, so just check that the file is loaded. This is
;; a useful error check that has saved a lot of time since Defsystem
;; is far from fool-proof.
(defun load-macsyma-macros-at-runtime (&rest l)
(mapcar #'(lambda (x) (unless (get x 'macsyma-module)
(error "Missing Maxima macro file -- ~A" x)))
l))
(defmacro load-macsyma-macros (&rest macro-files)
(apply #'load-macsyma-macros-at-runtime macro-files)
(values))
(defmacro with-new-context (sub-context &rest forms)
`(let ((my-context (gensym "$CTXT")))
(mfuncall '$supcontext my-context ,@sub-context)
(unwind-protect
(prog1 ,@forms)
($killcontext my-context))))
;; For creating a macsyma evaluator variable binding context.
;; (MBINDING (VARIABLES &OPTIONAL VALUES FUNCTION-NAME)
;; ... BODY ...)
(defmacro mbinding (variable-specification &rest body &aux (temp (gensym)))
`(let ((,temp ,(car variable-specification)))
;; Don't optimize out this temporary, even if (CAR VARIABLE-SPECICIATION)
;; is an ATOM. We don't want to risk side-effects.
,(case (length variable-specification)
((1)
`(mbinding-sub ,temp ,temp nil ,@body))
((2)
`(mbinding-sub ,temp ,(cadr variable-specification) nil ,@body))
((3)
`(mbinding-sub ,temp ,(cadr variable-specification)
,(caddr variable-specification)
,@body))
(t
(maxima-error "Bad variable specification: ~a" variable-specification)))))
(defmacro mbinding-sub (variables values function-name &rest body &aux (win (gensym)))
`(let ((,win nil))
(unwind-protect
(progn
(mbind ,variables ,values ,function-name)
(setq ,win t)
,@body)
(if ,win (munbind ,variables)))))
;; How About MTYPEP like (MTYPEP EXP 'ATAN) or (MTYPEP EXP '*) - Jim.
;; Better, (EQ (MTYPEP EXP) 'ATAN).
(defmacro matanp (x)
`(let ((thing ,x))
(and (not (atom thing)) (eq (caar thing) '%atan))))
;; Macros used in LIMIT, DEFINT, RESIDU.
;; If we get a lot of these, they can be split off into a separate macro
;; package.
(defmacro real-infinityp (x)
`(member ,x real-infinities :test #'eq))
(defun infinityp (x)
(member x infinities :test #'eq))
(defmacro real-epsilonp (x)
`(member ,x infinitesimals :test #'eq))
(defmacro free-epsilonp (x)
`(not (amongl infinitesimals ,x)))
(defmacro free-infp (x)
`(not (amongl infinities ,x)))
(defmacro inf-typep (x)
`(car (amongl infinities ,x)))
(defmacro epsilon-typep (x)
`(car (amongl infinitesimals ,x)))
(defmacro hot-coef (p)
`(pdis (caddr (cadr (rat-no-ratfac ,p)))))
(defmacro defmspec (function . rest)
`(progn
(defun-prop (,function mfexpr*) ,@rest)))
;; Setf hacking.
(defmfun mget (atom ind)
(let ((props (and (symbolp atom) (get atom 'mprops))))
(and props (getf (cdr props) ind))))
(defsetf mget (sym tag) (value)
`(mputprop ,sym ,value ,tag))
(defmacro old-get (plist tag)
`(getf (cdr ,plist) ,tag))
(defmfun $get (atom ind)
(prop1 '$get atom nil ind))
(defsetf $get (sym tag) (value)
`($put ,sym ,value ,tag))
(defmacro mdefprop (sym val indicator)
`(mputprop ',sym ',val ',indicator))
(defmfun mputprop (atom val ind)
(let ((props (get atom 'mprops)))
(if (null props) (putprop atom (setq props (ncons nil)) 'mprops))
(putprop props val ind)))
|