-;;; Tweak *LEXENV* to include the MACROBINDINGS from a SYMBOL-MACROLET,
-;;; then call FUN (with no arguments).
-;;;
-;;; This is split off from the IR1 convert method so that it can be
-;;; shared by the special-case top-level SYMBOL-MACROLET processing code.
-(defun funcall-in-symbol-macrolet-lexenv (macrobindings fun)
- (declare (type list macrobindings) (type function fun))
- (let ((processed-macrobindings
- (mapcar (lambda (macrobinding)
- (unless (proper-list-of-length-p macrobinding 2)
- (compiler-error "malformed symbol/expansion pair: ~S"
- macrobinding))
- (destructuring-bind (name expansion) macrobinding
- (unless (symbolp name)
- (compiler-error
- "The local symbol macro name ~S is not a symbol."
- name))
- `(,name . (MACRO . ,expansion))))
- macrobindings)))
- (unless (= (length macrobindings)
- (length (remove-duplicates macrobindings :key #'first)))
- (compiler-style-warning
- "duplicate symbol macro names in SYMBOL-MACROLET ~S" macrobindings))
- (let ((*lexenv* (make-lexenv :variables processed-macrobindings)))
- (funcall fun)))
- (values))
+(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
+ (%funcall-in-foomacrolet-lexenv
+ (lambda (definition)
+ (unless (proper-list-of-length-p definition 2)
+ (compiler-error "malformed symbol/expansion pair: ~S" definition))
+ (destructuring-bind (name expansion) definition
+ (unless (symbolp name)
+ (compiler-error
+ "The local symbol macro name ~S is not a symbol."
+ name))
+ `(,name . (MACRO . ,expansion))))
+ :variables
+ definitions
+ fun))