share/contrib/noninteractive/noninteractive.lisp

   1 ;; noninteractive.lisp -- some functions to be used by noninteractive.mac
   2 ;; copyright 2007 by Robert Dodier
   3 ;; I release this file under the terms of the GNU General Public License.
   4
   5 ;; Redefine MERROR to throw something.
   6 (defun merror (s &rest l) ($throw `((merror) ,s ,@l)))
   7
   8 (defmspec $assuming (e)
   9   (let*
  10     ((args (margs e))
  11      (assumptions (mapcar #'meval (extract-assumptions (first args))))
  12      (my-context (mfuncall '$supcontext)))
  13     (meval `(($assume) ,@assumptions))
  14     (unwind-protect
  15       (first (last (mapcar #'(lambda (e) (mfuncall '|$meval1| e)) (rest args))))
  16       (mfuncall '$killcontext my-context))))
  17
  18 (defun extract-assumptions (x)
  19   (if ($listp x) (rest x) (list x)))
  20
  21 ;; Remove functions and variables defined at Maxima level
  22 ;; so that kill does not affect noninteractive.
  23 ;; Unfortunately, this function has to revised if any more
  24 ;; functions or variables are defined.
  25 ;; Maybe there should be a way to mark a function as unkillable
  26 ;; when it is defined. Just a thought.
  27
  28 (defmfun $delete_noninteractive_stuff_from_infolists ()
  29   (setq $values (delete '|$within_MEVAL1| $values))
  30   (setq $functions (delete '((|$meval1|)) $functions :test #'equal))
  31   (setq $functions (delete '(($ENUMERATE_CASES) |$l%|) $functions :test #'equal))
  32   (setq $functions (delete '(($INTERLEAVE) |$l1| |$l2|) $functions :test #'equal))
  33   '$done)