+;;; shared by the special-case top level MACROLET processing code, and
+;;; further split so that the special-case MACROLET processing code in
+;;; EVAL can likewise make use of it.
+(defmacro macrolet-definitionize-fun (context lexenv)
+ (flet ((make-error-form (control &rest args)
+ (ecase context
+ (:compile `(compiler-error ,control ,@args))
+ (:eval `(error 'simple-program-error
+ :format-control ,control
+ :format-arguments (list ,@args))))))
+ `(lambda (definition)
+ (unless (list-of-length-at-least-p definition 2)
+ ,(make-error-form
+ "The list ~S is too short to be a legal local macro definition."
+ 'definition))
+ (destructuring-bind (name arglist &body body) definition
+ (unless (symbolp name)
+ ,(make-error-form "The local macro name ~S is not a symbol." 'name))
+ (unless (listp arglist)
+ ,(make-error-form
+ "The local macro argument list ~S is not a list."
+ 'arglist))
+ (with-unique-names (whole environment)
+ (multiple-value-bind (body local-decls)
+ (parse-defmacro arglist whole body name 'macrolet
+ :environment environment)
+ `(,name macro .
+ ,(compile-in-lexenv
+ nil
+ `(lambda (,whole ,environment)
+ ,@local-decls
+ (block ,name ,body))
+ ,lexenv))))))))
+