src/lsp/compiler/cmpmacro.lsp

   1 (in-package "XLSCMP")
   2
   3 ;;;;
   4 ;;;; Compiler Macro Expansion
   5 ;;;;
   6
   7 ;;**** move to proper place?
   8 (defvar *cmp-macros* nil)
   9 (defvar *cmp-global-macros* nil)
  10
  11 ;;**** think about precedence if macro and cmpmacro both exist
  12 ;;**** may simplify setf that way?
  13
  14 (defun cmp-macroexpand (e &optional (env (list nil
  15                                                *cmp-fenv*
  16                                                *cmp-macros*
  17                                                *cmp-global-macros*)))
  18   (macroexpand e env))
  19
  20 (defun cmp-macroexpand-1 (e &optional (env (list nil
  21                                                  *cmp-fenv*
  22                                                  *cmp-macros*
  23                                                  *cmp-global-macros*)))
  24   (macroexpand-1 e env))
  25
  26
  27 ;;;;
  28 ;;;; Declaration Handling
  29 ;;;;
  30
  31 (defun check-declarations (decls)
  32   (dolist (d decls)
  33     (dolist (i (rest d))
  34       (if (and (consp i) (eq (first i) 'special))
  35           (dolist (v (rest i))
  36             (warn "special declaration for ~s ignored." v))))))
  37
  38 (defun split-declarations (x)
  39   (flet ((head-is-declaration (x)
  40            (and (consp (first x)) (eq (first (first x)) 'declare)))
  41          (head-is-docstring (x) (and (stringp (first x)) (consp (rest x)))))
  42     (do ((decls nil)
  43          (body x (rest body))
  44          (doc nil))
  45         (nil)
  46         (cond
  47          ((head-is-declaration body) (push (first body) decls))
  48          ((head-is-docstring body) (setf doc (first body)))
  49          (t (check-declarations decls)
  50             #|(return (list (nreverse decls) body doc))|#
  51             (return (list nil body doc))))))) ; drop declarations for now
  52
  53
  54 ;;;;
  55 ;;;; PROGV
  56 ;;;;
  57
  58 (define-compiler-macro progv (syms vals &rest body)
  59   `(%dynamic-bind ,syms ,vals #'(lambda () ,@body)))
  60
  61
  62
  63 ;;;;
  64 ;;;; Macros for inlining some functions
  65 ;;;; ******* more needed here -- should these be here or as symbol-call-rules??
  66
  67 (define-compiler-macro not (x) `(if ,x nil t))
  68 (define-compiler-macro null (x) `(if ,x nil t))
  69
  70 (define-compiler-macro row-major-aref (x i) `(aref ,x ,i))
  71 (define-compiler-macro xlisp::%set-rm-aref (x i v)
  72   `(xlisp::%set-aref ,x ,i ,v))