src/lmdcls.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 8 -*- ;;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancements.                   ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9 (in-package :maxima)
  10
  11 (defvar *macro-file* nil)
  12
  13 #+gcl
  14 (progn
  15   (system::clines "object MAKE_UNSPECIAL(object x) {if (type_of(x)==t_symbol) x->s.s_stype=0;return Cnil;}")
  16   (system::defentry make-unspecial (system::object) (system::object "MAKE_UNSPECIAL")))
  17
  18 #+(or scl cmu)
  19 (defun make-unspecial (symbol)
  20   (ext:clear-info variable c::kind symbol)
  21   symbol)
  22
  23
  24 (defmacro declare-top (&rest decl-specs)
  25   `(eval-when
  26     ,(cond (*macro-file*  '(:compile-toplevel :load-toplevel :execute) )
  27            (t '(:compile-toplevel :execute)))
  28     ,@(loop for v in decl-specs
  29              unless (member (car v) '(special unspecial)) nconc nil
  30              else
  31              when (eql (car v) 'unspecial)
  32              collect `(progn
  33                        ,@(loop for w in (cdr v)
  34                                 collect #-(or gcl scl cmu ecl)
  35                                        `(remprop ',w
  36                                                  #-excl 'special
  37                                                  #+excl 'excl::.globally-special.)
  38                                 #+(or gcl scl cmu ecl)
  39                                 `(make-unspecial ',w)))
  40              else collect `(proclaim ',v))))
  41
  42 (declaim (declaration unspecial))