|#
(declaim (ftype (sfunction
- (symbol &optional (or null sb-kernel:lexenv))
+ (symbol &optional (or null lexenv))
(values (member nil :special :lexical :symbol-macro :constant)
boolean
list))
variable-information))
(defun variable-information (var &optional env)
- (let* ((*lexenv* (or env (sb-kernel:make-null-lexenv)))
+ "Return three values. The first indicates a binding kind of VAR; the
+second is True if there is a local binding of VAR; the third is an
+alist of declarations that apply to the apparent binding of VAR."
+ (let* ((*lexenv* (or env (make-null-lexenv)))
(info (lexenv-find var vars)))
(etypecase info
- (sb-c::leaf (let ((type (sb-kernel:type-specifier
- (sb-kernel:type-intersection
+ (sb-c::leaf (let ((type (type-specifier
+ (type-intersection
(sb-c::leaf-type info)
(or (lexenv-find info type-restrictions)
- sb-kernel:*universal-type*)))))
+ *universal-type*)))))
(etypecase info
(sb-c::lambda-var
(values :lexical t
(:global nil))
nil
`( ; XXX ignore
- (type . ,(sb-kernel:type-specifier ; XXX local type
+ (type . ,(type-specifier ; XXX local type
(info :variable :type var)))))))))
-(defun parse-macro (name lambda-list body
- &optional env)
+(declaim (ftype (sfunction (symbol &optional (or null lexenv)) t)
+ declaration-information))
+(defun declaration-information (declaration-name &optional env)
+ (let ((env (or env (make-null-lexenv))))
+ (case declaration-name
+ (optimize
+ (let ((policy (sb-c::lexenv-policy env)))
+ (collect ((res))
+ (dolist (name sb-c::*policy-qualities*)
+ (res (list name (cdr (assoc name policy)))))
+ (loop for (name . nil) in sb-c::*policy-dependent-qualities*
+ do (res (list name (sb-c::policy-quality policy name))))
+ (res))))
+ (sb-ext:muffle-conditions
+ (car (rassoc 'muffle-warning
+ (sb-c::lexenv-handled-conditions env))))
+ (t (error "Unsupported declaration ~S." declaration-name)))))
+
+(defun parse-macro (name lambda-list body &optional env)
(declare (ignore env))
(with-unique-names (whole environment)
(multiple-value-bind (body decls)
- (sb-kernel:parse-defmacro lambda-list whole body name
- 'parse-macro
- :environment environment)
+ (parse-defmacro lambda-list whole body name
+ 'parse-macro
+ :environment environment)
`(lambda (,whole ,environment)
,@decls
,body))))
-(defun enclose (lambda-expression
- &optional env)
+(defun enclose (lambda-expression &optional env)
(let ((env (if env
(sb-c::make-restricted-lexenv env)
- (sb-kernel:make-null-lexenv))))
+ (make-null-lexenv))))
(compile-in-lexenv nil lambda-expression env)))