cmp: rename env functions to comply to other naming conventions

c1make-global-variable -> make-global-var (and move to cmpvar) -- this function
does not create c1form so this name was wrong

cmp-env-declare-special -> declare-special (and move to cmpenv-var) -- this
function does not only declare special but it also creates an instance of a
variable - move that to a new file cmpenv-var.lsp

src/cmp/cmpenv-api.lsp

@@ -19,7 +19,7 @@
 (defun cmp-env-root (&optional (env *cmp-env-root*))
   "Provide a root environment for toplevel forms storing all declarations
 that are susceptible to be changed by PROCLAIM."
-  (let* ((env (cmp-env-copy env)))
+  (let ((env (cmp-env-copy env)))
     (add-default-optimizations env)))
 
 (defun cmp-env-copy (&optional (env *cmp-env*))
@@ -41,13 +41,6 @@ that are susceptible to be changed by PROCLAIM."
         (cmp-env-variables env))
   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)
-
 (defun cmp-env-add-declaration (type arguments &optional (env *cmp-env*))
   (push (list* :declare type arguments) 
         (cmp-env-variables env))

src/cmp/cmpenv-declaim.lsp

@@ -26,12 +26,12 @@
   (flet ((add-variables (env types specials)
            (loop for name in specials
               unless (assoc name types)
-              do (let ((v (c1make-global-variable name :kind 'special)))
+              do (let ((v (make-global-var name :kind 'special)))
                    (setf env (cmp-env-register-var v env nil))))
            (loop for (name . type) in types
               for specialp = (or (si:specialp name) (member name specials))
               for kind = (if specialp 'SPECIAL 'GLOBAL)
-              for v = (c1make-global-variable name :type type :kind kind)
+              for v = (make-global-var name :type type :kind kind)
               do (setf env (cmp-env-register-var v env nil)))
            env))
     (multiple-value-bind (body specials types ignored others doc all)

src/cmp/cmpenv-var.lsp

@@ -0,0 +1,14 @@
+
+;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya
+;;;;  Copyright (c) 1990, Giuseppe Attardi
+;;;;  Copyright (c) 2003, Juan Jose Garcia-Ripoll
+;;;;  Copyright (c) 2023, Daniel Kochmański
+;;;;
+;;;;    See file 'LICENSE' for the copyright details.
+
+(in-package #:compiler)
+
+(defun 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 (make-global-var name :warn nil :kind 'SPECIAL) env nil))

src/cmp/cmppass1-eval.lsp

@@ -85,7 +85,7 @@
       (c1body args t)
     (if (or ss ts is other-decl)
         (let ((*cmp-env* (cmp-env-copy)))
-          (mapc #'cmp-env-declare-special ss)
+          (mapc #'declare-special ss)
           (check-vdecl nil ts is)
           (c1decl-body other-decl body))
         (c1progn body))))

src/cmp/cmppass1-fun.lsp

@@ -71,7 +71,7 @@
     (let ((*cmp-env* new-env))
       (multiple-value-bind (body ss ts is other-decl)
           (c1body (rest args) t)
-        (mapc #'cmp-env-declare-special ss)
+        (mapc #'declare-special ss)
         (check-vdecl nil ts is)
         (setq body-c1form (c1decl-body other-decl body))))
 

src/cmp/cmppass1-var.lsp

@@ -120,7 +120,7 @@
       (values vars forms specials other-decls body))))
 
 (defun process-let-body (let/let* vars forms specials other-decls body setjmps)
-  (mapc #'cmp-env-declare-special specials)
+  (mapc #'declare-special specials)
   (setf body (c1decl-body other-decls body))
   ;; Try eliminating unused variables, replace constant ones, etc.
   (multiple-value-setq (vars forms)
@@ -235,7 +235,7 @@
                      name type))
            (when (eq type 'T)
              (setf type (or (si:get-sysprop name 'CMP-TYPE) 'T)))
-           (c1make-global-variable name :kind 'SPECIAL :type type))
+           (make-global-var name :kind 'SPECIAL :type type))
           (t
            (make-var :name name :type type :loc 'OBJECT
                      :kind kind :ignorable ignorable
@@ -257,8 +257,8 @@
       (cmp-env-search-var name)
     (declare (ignore unw))
     (cond ((null var)
-           (c1make-global-variable name :warn t
-                                        :type (or (si:get-sysprop name 'CMP-TYPE) t)))
+           (make-global-var name :warn t
+                                 :type (or (si:get-sysprop name 'CMP-TYPE) t)))
           ((not (var-p var))
            ;; symbol-macrolet
            (baboon :format-control "c1vref: ~s is not a variable."
@@ -277,19 +277,6 @@
                         (var-name var)))))
            var))))
 
-(defun c1make-global-variable (name &key
-                               (type (or (si:get-sysprop name 'CMP-TYPE) t))
-                               (kind 'GLOBAL)
-                               (warn nil))
-  (let* ((var (make-var :name name :kind kind :type type :loc (add-symbol name))))
-    (when warn
-      (unless (or (constantp name)
-                  (special-variable-p name)
-                  (member name *undefined-vars*))
-        (undefined-variable name)
-        (push name *undefined-vars*)))
-    var))
-
 (defun c1setq (args)
   (let ((l (length args)))
     (cmpck (oddp l) "SETQ requires an even number of arguments.")
@@ -370,7 +357,7 @@
            ,@args)))
     (multiple-value-bind (body ss ts is other-decls)
         (c1body args nil)
-      (mapc #'cmp-env-declare-special ss)
+      (mapc #'declare-special ss)
       (let* ((vars (loop for name in variables
                          collect (c1make-var name ss is ts))))
         (setq init-form (c1expr init-form))

src/cmp/cmpvar.lsp

@@ -99,6 +99,19 @@
     (setq type 'T))
   (make-var :kind rep-type :type type :loc (next-lcl)))
 
+(defun make-global-var (name &key
+                               (type (or (si:get-sysprop name 'CMP-TYPE) t))
+                               (kind 'GLOBAL)
+                               (warn nil))
+  (let ((var (make-var :name name :kind kind :type type :loc (add-symbol name))))
+    (when warn
+      (unless (or (constantp name)
+                  (special-variable-p name)
+                  (member name *undefined-vars*))
+        (undefined-variable name)
+        (push name *undefined-vars*)))
+    var))
+
 (defun make-temp-var (&optional (type 'T))
   (make-var :kind :object :type type :loc `(TEMP ,(next-temp))))
 

src/cmp/load.lsp.in

@@ -10,6 +10,7 @@
     "src:cmp;cmpcond.lsp"
     ;; Environment
     "src:cmp;cmpenv-api.lsp"
+    "src:cmp;cmpenv-var.lsp"
     "src:cmp;cmpenv-fun.lsp"
     "src:cmp;cmpenv-declare.lsp"
     "src:cmp;cmpenv-proclaim.lsp"