compiler: better checking whether a variable may be introduced

Previously c1make-var checked whether the symbol NAME is CONSTANTP, but
ECL expands symbol macros in CONSTANTP so this returned false positives.
A similar concern applied to the CMP-ENV-REGISTER-SYMBOL-MACRO-FUNCTION.

C1EXPR-INNER when encountered a symbol tried to yield C1CONSTANT-VALUE
for if it iwas CONSTANTP - this was correct except for that we didn't
pass the environment to the predicate and symbols weren't shadowed.

In this commit one function is added to the core - si:constp (with
similar purpose to si:specialp) and one function to the compiler -
constant-variable-p (similar to special-variable-p) and they are
appropriately used when necessary. A regression test is added.

Fixes #662.

src/c/cmpaux.d

@@ -20,7 +20,13 @@ cl_object
 si_specialp(cl_object sym)
 {
   @(return ((ecl_symbol_type(sym) & ecl_stp_special)? ECL_T : ECL_NIL))
-    }
+}
+
+cl_object
+si_constp(cl_object sym)
+{
+  @(return ((ecl_symbol_type(sym) & ecl_stp_constant)? ECL_T : ECL_NIL))
+}
 
 cl_fixnum
 ecl_ifloor(cl_fixnum x, cl_fixnum y)

src/c/symbols_list.h

@@ -1284,6 +1284,7 @@ cl_symbols[] = {
 {SYS_ "SIGNAL-SIMPLE-ERROR" ECL_FUN("si_signal_simple_error", si_signal_simple_error, -5) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "SIGNAL-TYPE-ERROR" ECL_FUN("si_signal_type_error", si_signal_type_error, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "SPECIALP" ECL_FUN("si_specialp", si_specialp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
+{SYS_ "CONSTP" ECL_FUN("si_constp", si_constp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "STANDARD-READTABLE" ECL_FUN("si_standard_readtable", si_standard_readtable, 0) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "STEPPER" ECL_FUN("OBJNULL", OBJNULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
 {SYS_ "BASE-STRING-CONCATENATE" ECL_FUN("si_base_string_concatenate", si_base_string_concatenate, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},

src/cmp/cmpenv-api.lsp

@@ -152,7 +152,7 @@ the closure in let/flet forms for variables/functions it closes over."
                                           env))
 
 (defun cmp-env-register-symbol-macro-function (name function &optional (env *cmp-env*))
-  (when (or (constantp name) (special-variable-p name))
+  (when (or (constant-variable-p 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))

src/cmp/cmppass1-eval.lsp

@@ -25,7 +25,7 @@
                ((keywordp form)
                 (make-c1form* 'LOCATION :type (object-type form)
                               :args (add-symbol form)))
-               ((constantp form)
+               ((constantp form *cmp-env*)
                 (or (c1constant-value (symbol-value form) :only-small-values t)
                     (c1var form)))
                (t (c1var form))))

src/cmp/cmppass1-var.lsp

@@ -221,7 +221,7 @@
 
 (defun c1make-var (name specials ignores types)
   (cmpck (not (symbolp name)) "The variable ~s is not a symbol." name)
-  (cmpck (constantp name) "The constant ~s is being bound." name)
+  (cmpck (constant-variable-p name) "The constant ~s is being bound." name)
   (let ((ignorable (cdr (assoc name ignores)))
         (kind 'LEXICAL)                 ; we rely on check-vref to fix it
         (type (assoc name types)))

src/cmp/cmpvar.lsp

@@ -222,6 +222,9 @@
         ;; we also have to consider 'GLOBAL here.
         (and v (eq (var-kind v) 'SPECIAL)))))
 
+(defun constant-variable-p (name)
+  (si::constp name))
+
 (defun local-variable-p (name &optional (env *cmp-env*))
   (let ((record (cmp-env-search-var name env)))
     (and record (var-p record))))

src/h/external.h

@@ -506,6 +506,7 @@ extern ECL_API cl_object cl_class_of(cl_object x);
 /* cmpaux.c */
 
 extern ECL_API cl_object si_specialp(cl_object sym);
+extern ECL_API cl_object si_constp(cl_object sym);
 
 extern ECL_API cl_fixnum ecl_ifloor(cl_fixnum x, cl_fixnum y);
 extern ECL_API cl_fixnum ecl_imod(cl_fixnum x, cl_fixnum y);

src/tests/normal-tests/compiler.lsp

@@ -2046,3 +2046,18 @@
   (is (equal '((quote) (quote a b c))
              (funcall
               (compile nil '(lambda () (let ((x '(quote)) (y '(quote a b c))) (list x y))))))))
+
+;;; Date 2021-11-19
+;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/662
+;;; Description
+;;;
+;;;     In ccmp a global symbol macro cannot be lexically rebound.
+;;;
+(test cmp.0089.symbol-macro
+  (when (finishes
+         (with-compiler ("cmp.0089.symbol-macro.lsp" :load t)
+           `(define-symbol-macro cmp.0089.sym 42)
+           `(defun cmp.0089.fun1 (cmp.0089.sym) cmp.0089.sym)
+           `(defun cmp.0089.fun2 () cmp.0089.sym)))
+    (is (= 15 (cmp.0089.fun1 15)))
+    (is (= 42 (cmp.0089.fun2)))))