5 declaration-information
11 (declaim (ftype (sfunction
12 (symbol &optional (or null lexenv))
13 (values (member nil :special :lexical :symbol-macro :constant)
16 variable-information))
17 (defun variable-information (var &optional env)
18 "Return three values. The first indicates a binding kind of VAR; the
19 second is True if there is a local binding of VAR; the third is an
20 alist of declarations that apply to the apparent binding of VAR."
21 (let* ((*lexenv* (or env (make-null-lexenv)))
22 (info (lexenv-find var vars)))
24 (sb-c::leaf (let ((type (type-specifier
26 (sb-c::leaf-type info)
27 (or (lexenv-find info type-restrictions)
32 `((ignore . ,(sb-c::lambda-var-ignorep info))
36 `((type . ,type)) ; XXX ignore
40 `((type . ,type)) ; XXX ignore
42 (cons (values :symbol-macro t
43 nil ; FIXME: also in the compiler
45 (null (values (ecase (info :variable :kind var)
48 (:macro :symbol-macro)
52 (type . ,(type-specifier ; XXX local type
53 (info :variable :type var)))))))))
55 (declaim (ftype (sfunction (symbol &optional (or null lexenv)) t)
56 declaration-information))
57 (defun declaration-information (declaration-name &optional env)
58 (let ((policy (sb-c::lexenv-policy (or env (make-null-lexenv)))))
59 (case declaration-name
60 (optimize (collect ((res))
61 (dolist (name sb-c::*policy-qualities*)
62 (res (list name (cdr (assoc name policy)))))
63 (loop for (name . nil) in sb-c::*policy-dependent-qualities*
64 do (res (list name (sb-c::policy-quality policy name))))
66 (t (error "Unsupported declaration ~S." declaration-name)))))
68 (defun parse-macro (name lambda-list body &optional env)
69 (declare (ignore env))
70 (with-unique-names (whole environment)
71 (multiple-value-bind (body decls)
72 (parse-defmacro lambda-list whole body name
74 :environment environment)
75 `(lambda (,whole ,environment)
79 (defun enclose (lambda-expression &optional env)
81 (sb-c::make-restricted-lexenv env)
83 (compile-in-lexenv nil lambda-expression env)))