From 9eff84b622b1ffaffbef374bca865a3390a58e13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Thu, 16 Feb 2023 18:25:31 +0100 Subject: [PATCH] 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 | 9 +-------- src/cmp/cmpenv-declaim.lsp | 4 ++-- src/cmp/cmpenv-var.lsp | 14 ++++++++++++++ src/cmp/cmppass1-eval.lsp | 2 +- src/cmp/cmppass1-fun.lsp | 2 +- src/cmp/cmppass1-var.lsp | 23 +++++------------------ src/cmp/cmpvar.lsp | 13 +++++++++++++ src/cmp/load.lsp.in | 1 + 8 files changed, 38 insertions(+), 30 deletions(-) create mode 100644 src/cmp/cmpenv-var.lsp diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index e735d87de..bc1fad6b2 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/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)) diff --git a/src/cmp/cmpenv-declaim.lsp b/src/cmp/cmpenv-declaim.lsp index 33bd27b01..4b189b79d 100644 --- a/src/cmp/cmpenv-declaim.lsp +++ b/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) diff --git a/src/cmp/cmpenv-var.lsp b/src/cmp/cmpenv-var.lsp new file mode 100644 index 000000000..aa29a765e --- /dev/null +++ b/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)) diff --git a/src/cmp/cmppass1-eval.lsp b/src/cmp/cmppass1-eval.lsp index b19a8046b..3a83e76cc 100644 --- a/src/cmp/cmppass1-eval.lsp +++ b/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)))) diff --git a/src/cmp/cmppass1-fun.lsp b/src/cmp/cmppass1-fun.lsp index da447459f..23086823a 100644 --- a/src/cmp/cmppass1-fun.lsp +++ b/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)))) diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp index 80b0b39bc..b9a42d0d4 100644 --- a/src/cmp/cmppass1-var.lsp +++ b/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)) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index e7c204948..f2f5765e4 100644 --- a/src/cmp/cmpvar.lsp +++ b/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)))) diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in index d1408c384..131ed65a0 100644 --- a/src/cmp/load.lsp.in +++ b/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"