src/displm.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 1982 Massachusetts Institute of Technology         ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package :maxima)
  12
  13 (macsyma-module displm macro)
  14
  15 (declare-top
  16  ;; evaluate for declarations
  17  (special
  18   linel                 ;Width of screen.
  19   ttyheight             ;Height of screen.
  20
  21   width height depth maxht maxdp level size lop rop break right
  22   bkpt bkptwd bkptht bkptdp bkptlevel bkptout lines
  23   oldrow oldcol in-p
  24   mratp $aliases))
  25
  26 ;;; macros for the DISPLA package.
  27
  28 ;; (PUSH-STRING "foo" RESULT) --> (SETQ RESULT (APPEND '(#/o #/o #/f) RESULT))
  29
  30 (defmacro push-string (string symbol)
  31   (check-arg symbol symbolp "a symbol")
  32   (if (stringp string)
  33     `(setq ,symbol (list* ,@(nreverse (exploden string)) ,symbol))
  34     `(setq ,symbol (append (nreverse (exploden ,string)) ,symbol))))
  35
  36 ;; Macros for setting up dispatch table.
  37 ;; Don't call this DEF-DISPLA, since it shouldn't be annotated by
  38 ;; TAGS and @.  Syntax is:
  39 ;; (DISPLA-DEF [<operator>] [<dissym> | <l-dissym> <r-dissym>] [<lbp>] [<rbp>])
  40 ;; If only one integer appears in the form, then it is taken to be an RBP.
  41
  42 ;; This should be modified to use GJC's dispatch scheme where the subr
  43 ;; object is placed directly on the symbol's property list and subrcall
  44 ;; is used when dispatching.
  45
  46 (defmacro displa-def (operator dim-function &rest rest &aux l-dissym r-dissym lbp rbp)
  47   (dolist (x rest)
  48     (cond ((stringp x)
  49            (if l-dissym (setq r-dissym x) (setq l-dissym x)))
  50           ((integerp x)
  51            (if rbp (setq lbp rbp))
  52            (setq rbp x))
  53           (t (merror "DISPLA-DEF: unrecognized object: ~a" x))))
  54   (when l-dissym
  55     (setq l-dissym (if r-dissym
  56                        (cons (exploden l-dissym) (exploden r-dissym))
  57                        (exploden l-dissym))))
  58   `(progn
  59     (defprop ,operator ,dim-function dimension)
  60     ,(when l-dissym  `(defprop ,operator ,l-dissym dissym))
  61     ,(when lbp       `(defprop ,operator ,lbp lbp))
  62     ,(when rbp       `(defprop ,operator ,rbp rbp))))