From e466823ac6836bfb9b2a01c5d0f8f411aaddb03e Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Thu, 11 Mar 2021 20:46:27 +0100
Subject: [PATCH] cmp: be more strict with symbol-macrolet

The ansi standard specifies that declaring symbols bound with
symbol-macrolet to be special or binding symbols that are defined as
global variables must signal a program-error. Previously, we simply
ignored this issues.

Also fix an issue with cmp-env-search-variables which would wrongly
return variables when searching for symbol macros. This allows us to
remove another check in symbol-macro-declaration-p.
---
 src/cmp/cmpenv-api.lsp     | 18 +++++++++++-------
 src/cmp/cmpenv-declare.lsp |  9 ++++-----
 2 files changed, 15 insertions(+), 12 deletions(-)

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