/usr/share/maxima/5.41.0/src/inmis.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 | ;;; -*- 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 inmis)
(declare-top (special listofvars))
(defmvar $listconstvars nil
"Causes LISTOFVARS to include %E, %PI, %I, and any variables declared
constant in the list it returns if they appear in exp. The default is
to omit these." boolean see-also $listofvars)
(defmvar $listdummyvars t)
(defmfun $unknown (f) (catch 'unknown (unknown (specrepcheck f))))
(defun unknown (f)
(and (not (mapatom f))
(cond ((and (eq (caar f) 'mqapply)
(not (zl-get (caaadr f) 'specsimp)))
(throw 'unknown t))
((not (zl-get (caar f) 'operators)) (throw 'unknown t))
(t (mapc #'unknown (cdr f)) nil))))
(defmfun $listofvars (e)
(let ((listofvars (ncons '(mlist))))
(when ($ratp e)
(and (member 'trunc (cddar e) :test #'eq) (setq e ($taytorat e)))
(setq e (cons '(mlist)
(sublis (mapcar #'cons
(car (cdddar e))
;; GENSYMLIST
(caddar e))
;; VARLIST
(union* (listovars (cadr e))
(listovars (cddr e)))))))
(atomvars e)
(if (not $listdummyvars)
(dolist (u (cdr listofvars))
(if (freeof u e)
(setq listofvars (delete u listofvars :count 1 :test #'equal)))))
listofvars))
(defun atomvars (e)
(cond ((and (symbolp e)
(or $listconstvars
;; Do not add constants or boolean values to list of vars.
(and (not ($constantp e))
(not (member e '(t $true nil $false))))))
(add2lnc e listofvars))
((atom e))
((specrepp e) (atomvars (specdisrep e)))
((member 'array (car e) :test #'eq) (myadd2lnc e listofvars))
(t (mapc #'atomvars (margs e)))))
(defun myadd2lnc (item list)
(and (not (memalike item list)) (nconc list (ncons item))))
;; Bind variables declared with DEFMVAR to their initial values.
;; Some initial values are non-Maxima expressions, e.g., (2 3 5 7)
;; Attempt to handle those as well as Maxima expressions.
;; No attempt is made to handle variables declare with DEFVAR or by other means.
(defun maybe-reset (key val actually-reset reset-verbose)
(declare (special munbindp))
; MAYBE DEFMVAR VALUES SHOULD ONLY BE MAXIMA EXPRESSIONS ??
(let ((non-maxima (and (consp val) (not (consp (car val))))))
(when
; TEST (BOUNDP KEY), OTHERWISE ATTEMPT TO COMPARE VALUES FAILS ...
(and (boundp key)
(if non-maxima
; Apply EQUALP to non-Maxima expressions.
(not (equalp (symbol-value key) val))
; Apply ALIKE1 to Maxima expressions.
(not (alike1 (symbol-value key) val))))
(when reset-verbose
; ATTEMPT TO COPE WITH NON-MAXIMA EXPRESSIONS FOR BENEFIT OF DISPLA
(let ((displa-val (if non-maxima `((mprogn) ,@val) val)))
(displa `((mtext) "reset: bind " ,key " to " ,displa-val))))
(nconc actually-reset (list key))
(let ((munbindp t))
(meval `((msetq) ,key ((mquote) ,val)))))))
(defmspec $reset_verbosely (L)
(reset-do-the-work (cdr L) t))
(defmspec $reset (L)
(reset-do-the-work (cdr L) nil))
(defun reset-do-the-work (args reset-verbose)
(let ((actually-reset (copy-tree '((mlist)))) ($lispdisp t))
(if args
(mapcar
#'(lambda (key)
(multiple-value-bind (val found-p) (gethash key *variable-initial-values*)
(if found-p (maybe-reset key val actually-reset reset-verbose))))
args)
(maphash
#'(lambda (key val)
(maybe-reset key val actually-reset reset-verbose))
*variable-initial-values*))
actually-reset))
|