Removal of COMPILER-LET

[moon (David A. Moon)]

Here is the code promised in the message I sent earlier today.  Steve,
you can put this on the MCL CD-ROM if you want.  An appropriate file name is
compiler-let.lisp.

First, a small example of how it's used.  More interesting usage would require
a larger example.

(defmacro test (symbol indicator &environment env)
  `(quote ,(get-compile-time-local-property symbol indicator env 'default)))

(with-compile-time-local-property (foo bar baz)
   (test foo bar))
 => BAZ
(with-compile-time-local-property (foo bar baz)
   (test foo fab))
 => DEFAULT

Now the code.  Note that there are two versions, the first for CLtL2, the
second for CLtL1.

;;; Replacement for COMPILER-LET, which has been removed from ANSI Common Lisp
;;; This facility lets us have pseudo property lists that reside in the lexical
;;; environment structure at macro expansion time

#-(OR CLOE-RUNTIME IBCL) (PROGN

;;; Put a compile-time property into the lexical environment
;;; This macro is to be invoked in macro expansions
(DEFMACRO WITH-COMPILE-TIME-LOCAL-PROPERTY (&ENVIRONMENT ENV
                                            (SYMBOL INDICATOR VALUE) &BODY BODY)
  (LET* ((DATABASE (COMPILE-TIME-LOCAL-PROPERTY-DATABASE ENV))
         (PLIST (ASSOC SYMBOL DATABASE)))
    (COND ((NULL PLIST)
           (PUSH (LIST SYMBOL INDICATOR VALUE) DATABASE))
          ((EQ (GETF (CDR PLIST) INDICATOR BODY) BODY)
           (SETQ DATABASE (SUBSTITUTE (LIST* SYMBOL INDICATOR VALUE (CDR PLIST))
                                      PLIST DATABASE)))
          (T
           (LET ((NEW-PLIST (COPY-LIST PLIST)))
             (SETF (GETF (CDR NEW-PLIST) INDICATOR) VALUE)
             (SETQ DATABASE (SUBSTITUTE NEW-PLIST PLIST DATABASE)))))
    ;; "Loosemore's Device"
    `(MACROLET ((GET-COMPILE-TIME-LOCAL-PROPERTY-1 () ',DATABASE))
       ,@BODY)))

;;; Retrieve a compile time property from the lexical environment
;;; This function is to be called from macro expanders
(DEFUN GET-COMPILE-TIME-LOCAL-PROPERTY (SYMBOL INDICATOR ENV &OPTIONAL DEFAULT)
  (LET ((PLIST (ASSOC SYMBOL (COMPILE-TIME-LOCAL-PROPERTY-DATABASE ENV))))
    (IF PLIST
        (GETF (CDR PLIST) INDICATOR DEFAULT)
        DEFAULT)))

(DEFUN COMPILE-TIME-LOCAL-PROPERTY-DATABASE (ENV)
  (MACROEXPAND-1 `(GET-COMPILE-TIME-LOCAL-PROPERTY-1) ENV))

;;; This macro gets shadowed by MACROLET.  Its expansion is the database.
(DEFMACRO GET-COMPILE-TIME-LOCAL-PROPERTY-1 ()
  `NIL)
);#-(OR CLOE-RUNTIME IBCL)

;;; Use this definition in Lisps where MACROLET is broken but COMPILER-LET
;;; has not yet been removed
#+(OR CLOE-RUNTIME IBCL) (PROGN

(DEFVAR *COMPILE-TIME-LOCAL-PROPERTIES* NIL)

;;; Put a compile-time property into the lexical environment
;;; This macro is to be invoked in macro expansions
(DEFMACRO WITH-COMPILE-TIME-LOCAL-PROPERTY ((SYMBOL INDICATOR VALUE) &BODY BODY)
  (LET* ((DATABASE *COMPILE-TIME-LOCAL-PROPERTIES*)
         (PLIST (ASSOC SYMBOL DATABASE)))
    (COND ((NULL PLIST)
           (PUSH (LIST SYMBOL INDICATOR VALUE) DATABASE))
          ((EQ (GETF (CDR PLIST) INDICATOR BODY) BODY)
           (SETQ DATABASE (SUBSTITUTE (LIST* SYMBOL INDICATOR VALUE (CDR PLIST))
                                      PLIST DATABASE)))
          (T
           (LET ((NEW-PLIST (COPY-LIST PLIST)))
             (SETF (GETF (CDR NEW-PLIST) INDICATOR) VALUE)
             (SETQ DATABASE (SUBSTITUTE NEW-PLIST PLIST DATABASE)))))
    ;; "Loosemore's Device"
    `(COMPILER-LET ((*COMPILE-TIME-LOCAL-PROPERTIES* ',DATABASE))
       ,@BODY)))

;;; Retrieve a compile time property from the lexical environment
;;; This function is to be called from macro expanders
(DEFUN GET-COMPILE-TIME-LOCAL-PROPERTY (SYMBOL INDICATOR ENV &OPTIONAL DEFAULT)
  (DECLARE (IGNORE ENV))
  (LET ((PLIST (ASSOC SYMBOL *COMPILE-TIME-LOCAL-PROPERTIES*)))
    (IF PLIST
        (GETF (CDR PLIST) INDICATOR DEFAULT)
        DEFAULT)))
);#+(OR CLOE-RUNTIME IBCL)