src/trprop.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancments.                    ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;;     (c) Copyright 1981 Massachusetts Institute of Technology         ;;;
   9 ;;;                 GJC 10:11pm  Tuesday, 14 July 1981                   ;;;
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11
  12 (in-package :maxima)
  13 (macsyma-module trprop)
  14
  15 ;; Many macsyma extension commands, e.g. $INFIX, $TELLSIMP,
  16 ;; $DEFTAYLOR work by doing explicit PUTPROPS.
  17 ;; These META-PROP functions allow selected commands to
  18 ;; also output DEFPROP's when processed in the Macsyma->lisp translation.
  19
  20 (defmvar meta-prop-p nil)
  21 (defmvar meta-prop-l nil)
  22
  23 (defun meta-output (form)
  24   (push form meta-prop-l)
  25   ;; unfortunately, MATCOM needs to see properties in order
  26   ;; to compose tellsimps. so eval it always.
  27   (eval form))
  28
  29 (defun meta-add2lnc (item ssymbol)
  30   (if meta-prop-p
  31       (meta-output `(add2lnc ',item ,ssymbol))
  32       (add2lnc item (symbol-value ssymbol))))
  33
  34 (defun meta-putprop (ssymbol item key)
  35   (if meta-prop-p
  36       (prog1 item (meta-output `(defprop ,ssymbol ,item ,key)))
  37       (putprop ssymbol item key)))
  38
  39 (defun meta-mputprop (ssymbol item key)
  40   (if meta-prop-p
  41       (prog1 item (meta-output `(mdefprop ,ssymbol ,item ,key)))
  42       (mputprop ssymbol item key)))
  43
  44 (defun meta-fset (ssymbol definition)
  45   (if meta-prop-p
  46       (prog1 definition (meta-output
  47                          `(fset ',ssymbol (coerce ',definition 'function))))
  48       (fset ssymbol (coerce definition 'function))))
  49