diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index 78d8ae89f..3ecc6652a 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -110,6 +110,8 @@ the closure in let/flet forms for variables/functions it closes over." env) (defun cmp-env-declare-special (name &optional (env *cmp-env*)) + (when (cmp-env-search-symbol-macro name env) + (cmperr "Symbol ~A cannot be declared special and appear in a symbol-macrolet." name)) (cmp-env-register-var (c::c1make-global-variable name :warn nil :kind 'SPECIAL) env nil) env) @@ -145,12 +147,13 @@ the closure in let/flet forms for variables/functions it closes over." env) (defun cmp-env-register-symbol-macro (name form &optional (env *cmp-env*)) - (push (list name 'si::symbol-macro - #'(lambda (whole env) (declare (ignore env whole)) form)) - (cmp-env-variables env)) - env) + (cmp-env-register-symbol-macro-function name + #'(lambda (whole env) (declare (ignore env whole)) form) + env)) (defun cmp-env-register-symbol-macro-function (name function &optional (env *cmp-env*)) + (when (or (constantp name) (special-variable-p name)) + (cmperr "Cannot bind the special or constant variable ~A with symbol-macrolet." name)) (push (list name 'si::symbol-macro function) (cmp-env-variables env)) env) @@ -208,12 +211,13 @@ the closure in let/flet forms for variables/functions it closes over." (when (member name (second record) :test #'eql) (setf found record) (return))) - ((eq (second record) 'si::symbol-macro) - (when (eq name 'si::symbol-macro) + ((eq name 'si::symbol-macro) + (when (eq (second record) 'si::symbol-macro) (setf found record)) (return)) (t - (setf found record) + (when (not (eq (second record) 'si::symbol-macro)) + (setf found record)) (return)))) (values (first (last found)) cfb unw))) diff --git a/src/cmp/cmpenv-declare.lsp b/src/cmp/cmpenv-declare.lsp index 25de42bc8..847e74ed6 100644 --- a/src/cmp/cmpenv-declare.lsp +++ b/src/cmp/cmpenv-declare.lsp @@ -168,11 +168,10 @@ special variable declarations, as these have been extracted before." env))))) (defun symbol-macro-declaration-p (name type) - (let* ((record (cmp-env-search-symbol-macro name))) - (when (and record (functionp record)) - (let* ((expression (funcall record name nil))) - (cmp-env-register-symbol-macro name `(the ,type ,expression))) - t))) + (when-let ((record (cmp-env-search-symbol-macro name))) + (let* ((expression (funcall record name nil))) + (cmp-env-register-symbol-macro name `(the ,type ,expression))) + t)) (defun check-vdecl (vnames ts is) (loop for (name . type) in ts