From acd1dd3c07beda08244cab9bf831804804d81e69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 13 Feb 2023 17:49:43 +0100 Subject: [PATCH] cmp: don't import symbols from the SYSTEM package Use proper package accessors instead. This was mostly already done. Removal of package imports make it easier to tell when symbols do not belong to cmp. --- src/cmp/cmpenv-api.lsp | 16 ++++++++-------- src/cmp/cmpenv-fun.lsp | 19 +++++++++---------- src/cmp/cmpglobals.lsp | 8 ++++---- src/cmp/cmpmain.lsp | 2 +- src/cmp/cmppackage.lsp | 6 +----- src/cmp/cmppass1-data.lsp | 6 +++--- src/cmp/cmppass2-data.lsp | 6 +++--- src/cmp/cmptables.lsp | 6 +++--- src/cmp/cmputil.lsp | 2 +- src/cmp/proclamations.lsp | 10 +++++----- 10 files changed, 38 insertions(+), 43 deletions(-) diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index 8967c1d64..e2c88b19c 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -53,9 +53,9 @@ the closure in let/flet forms for variables/functions it closes over." ,@record-def)) ,definition)))) ((and (listp record) (symbolp (car record))) - (cond ((eq (car record) 'si::macro) + (cond ((eq (car record) 'si:macro) (cmp-env-register-macro (cddr record) (cadr record) env)) - ((eq (car record) 'si::symbol-macro) + ((eq (car record) 'si:symbol-macro) (cmp-env-register-symbol-macro-function (cddr record) (cadr record) env)) (t (setf definition @@ -137,7 +137,7 @@ the closure in let/flet forms for variables/functions it closes over." (values)) (defun cmp-env-register-macro (name function &optional (env *cmp-env*)) - (push (list name 'si::macro function) + (push (list name 'si:macro function) (cmp-env-functions env)) env) @@ -154,7 +154,7 @@ the closure in let/flet forms for variables/functions it closes over." (defun cmp-env-register-symbol-macro-function (name function &optional (env *cmp-env*)) (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) + (push (list name 'si:symbol-macro function) (cmp-env-variables env)) env) @@ -211,12 +211,12 @@ the closure in let/flet forms for variables/functions it closes over." (when (member name (second record) :test #'eql) (setf found record) (return))) - ((eq name 'si::symbol-macro) - (when (eq (second record) 'si::symbol-macro) + ((eq name 'si:symbol-macro) + (when (eq (second record) 'si:symbol-macro) (setf found record)) (return)) (t - (when (not (eq (second record) 'si::symbol-macro)) + (when (not (eq (second record) 'si:symbol-macro)) (setf found record)) (return)))) (values (first (last found)) cfb unw))) @@ -228,7 +228,7 @@ the closure in let/flet forms for variables/functions it closes over." (cmp-env-search-variables :tag name env)) (defun cmp-env-search-symbol-macro (name &optional (env *cmp-env*)) - (cmp-env-search-variables name 'si::symbol-macro env)) + (cmp-env-search-variables name 'si:symbol-macro env)) (defun cmp-env-search-var (name &optional (env *cmp-env*)) (cmp-env-search-variables name t env)) diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp index 479d31ab9..211426b97 100644 --- a/src/cmp/cmpenv-fun.lsp +++ b/src/cmp/cmpenv-fun.lsp @@ -72,7 +72,7 @@ (when may-be-global (let ((fun (cmp-env-search-function fname env))) (when (or (null fun) (and (fun-p fun) (fun-global fun))) - (sys:get-sysprop fname 'PROCLAIMED-ARG-TYPES))))))) + (si:get-sysprop fname 'PROCLAIMED-ARG-TYPES))))))) (defun get-return-type (fname &optional (env *cmp-env*)) (let ((x (cmp-env-search-ftype fname env))) @@ -82,7 +82,7 @@ (values return-types t))) (let ((fun (cmp-env-search-function fname env))) (when (or (null fun) (and (fun-p fun) (fun-global fun))) - (sys:get-sysprop fname 'PROCLAIMED-RETURN-TYPE)))))) + (si:get-sysprop fname 'PROCLAIMED-RETURN-TYPE)))))) (defun get-local-arg-types (fun &optional (env *cmp-env*)) (let ((x (cmp-env-search-ftype (fun-name fun) env))) @@ -131,30 +131,30 @@ (dolist (fun fname-list) (unless (si::valid-function-name-p fun) (error "Not a valid function name ~s in INLINE proclamation" fun)) - (unless (sys:get-sysprop fun 'INLINE) - (sys:put-sysprop fun 'INLINE t) - (sys:rem-sysprop fun 'NOTINLINE)))) + (unless (si:get-sysprop fun 'INLINE) + (si:put-sysprop fun 'INLINE t) + (si:rem-sysprop fun 'NOTINLINE)))) (defun proclaim-notinline (fname-list) (dolist (fun fname-list) (unless (si::valid-function-name-p fun) (error "Not a valid function name ~s in NOTINLINE proclamation" fun)) - (sys:rem-sysprop fun 'INLINE) - (sys:put-sysprop fun 'NOTINLINE t))) + (si:rem-sysprop fun 'INLINE) + (si:put-sysprop fun 'NOTINLINE t))) (defun declared-inline-p (fname &optional (env *cmp-env*)) (let* ((x (cmp-env-search-declaration 'inline env)) (flag (assoc fname x :test #'same-fname-p))) (if flag (cdr flag) - (sys:get-sysprop fname 'INLINE)))) + (si:get-sysprop fname 'INLINE)))) (defun declared-notinline-p (fname &optional (env *cmp-env*)) (let* ((x (cmp-env-search-declaration 'inline env)) (flag (assoc fname x :test #'same-fname-p))) (if flag (null (cdr flag)) - (sys:get-sysprop fname 'NOTINLINE)))) + (si:get-sysprop fname 'NOTINLINE)))) (defun inline-possible (fname &optional (env *cmp-env*)) (not (declared-notinline-p fname env))) @@ -176,4 +176,3 @@ ;; locally we don't keep the definition. `(eval-when (:load-toplevel :execute) (si:put-sysprop ',fname 'inline ',form)))) - diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 3519d092c..d66ba333b 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -158,13 +158,13 @@ variable-record = (:block block-name) | (:tag ({tag-name}*)) | (:function function-name) | (var-name {:special | nil} bound-p) | - (symbol si::symbol-macro macro-function) | + (symbol si:symbol-macro macro-function) | (:declare type arguments) | SI:FUNCTION-BOUNDARY | SI:UNWIND-PROTECT-BOUNDARY macro-record = (function-name function) | - (macro-name si::macro macro-function) | + (macro-name si:macro macro-function) | (:declare name declaration) | SI:FUNCTION-BOUNDARY | SI:UNWIND-PROTECT-BOUNDARY @@ -179,7 +179,7 @@ that compared with the bytecodes compiler, these records contain an additional variable, block, tag or function object at the end.") (defvar *cmp-env-root* - (cons nil (list (list '#:no-macro 'si::macro (constantly nil)))) + (cons nil (list (list '#:no-macro 'si:macro (constantly nil)))) "This is the common environment shared by all toplevel forms. It can only be altered by DECLAIM forms and it is used to initialize the value of *CMP-ENV*.") @@ -268,7 +268,7 @@ lines are inserted, but the order is preserved") (defvar *static-constants* nil) ; constants that can be built as C values ; holds { ( object c-variable constant ) }* -(defvar *compiler-constants* nil) ; a vector with all constants +(defvar si:*compiler-constants* nil) ; a vector with all constants ; only used in COMPILE (defvar *global-vars* nil) ; variables declared special diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index f3080a20f..2ff7cba39 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -745,7 +745,7 @@ compiled successfully, returns the pathname of the compiled file" (*package* *package*) (*compile-print* nil) (*print-pretty* nil) - (*compiler-constants* t)) + (si:*compiler-constants* t)) "Args: (name &optional definition) If DEFINITION is NIL, NAME must be the name of a not-yet-compiled function. diff --git a/src/cmp/cmppackage.lsp b/src/cmp/cmppackage.lsp index 0c4737ff0..7db57fce6 100644 --- a/src/cmp/cmppackage.lsp +++ b/src/cmp/cmppackage.lsp @@ -51,10 +51,6 @@ #:compiler-message-form ;; Other operators. #:install-c-compiler - #:update-compiler-features) - (:import-from #:si - #:get-sysprop #:put-sysprop #:rem-sysprop #:macro - #:*compiler-constants* #:register-global - #:cmp-env-register-macrolet #:compiler-let)) + #:update-compiler-features)) (ext:package-lock '#:cl nil) diff --git a/src/cmp/cmppass1-data.lsp b/src/cmp/cmppass1-data.lsp index 8f9be2886..1e9d2ff03 100644 --- a/src/cmp/cmppass1-data.lsp +++ b/src/cmp/cmppass1-data.lsp @@ -90,14 +90,14 @@ (when used-p (setf (vv-used-p vv) t)) (return-from add-object vv)) - (when (and (null *compiler-constants*) - (si::need-to-make-load-form-p object)) + (when (and (null si:*compiler-constants*) + (si:need-to-make-load-form-p object)) ;; All objects created with MAKE-LOAD-FORM go into the permanent storage to ;; prevent two non-eq instances of the same object in the permanent and ;; temporary storage from being created (we can't move objects from the ;; temporary into the permanent storage once they have been created). (setf load-form-p t permanent t)) - (let* ((test (if *compiler-constants* 'eq 'equal-with-circularity)) + (let* ((test (if si:*compiler-constants* 'eq 'equal-with-circularity)) (item (if permanent (find object *permanent-objects* :test test :key #'vv-value) (or (find object *permanent-objects* :test test :key #'vv-value) diff --git a/src/cmp/cmppass2-data.lsp b/src/cmp/cmppass2-data.lsp index a83a54d08..8574a8dd5 100644 --- a/src/cmp/cmppass2-data.lsp +++ b/src/cmp/cmppass2-data.lsp @@ -17,8 +17,8 @@ (in-package "COMPILER") (defun data-dump-array () - (cond (*compiler-constants* - (setf *compiler-constants* (concatenate 'vector (data-get-all-objects))) + (cond (si:*compiler-constants* + (setf si:*compiler-constants* (concatenate 'vector (data-get-all-objects))) "") #+externalizable ((plusp (data-size)) @@ -219,7 +219,7 @@ ;; fields. SSE uses always unboxed static constants. No reference is kept to ;; them -- it is thus safe to use them even on code that might be unloaded. (unless (or #+msvc t - *compiler-constants* + si:*compiler-constants* (and (not *use-static-constants-p*) #+sse2 (not (typep object 'ext:sse-pack))) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index e649bf883..94625be54 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -152,7 +152,7 @@ '((ext:with-backend . c1with-backend) ; t1 (defmacro . t1defmacro) - (compiler-let . c1compiler-let) + (si:compiler-let . c1compiler-let) (eval-when . c1eval-when) (progn . c1progn) (macrolet . c1macrolet) @@ -235,7 +235,7 @@ (multiple-value-bind . c2multiple-value-bind) (function . c2function) - (ext:compiler-let . c2compiler-let) + (si:compiler-let . c2compiler-let) (with-stack . c2with-stack) (stack-push-values . c2stack-push-values) @@ -256,7 +256,7 @@ )) (defconstant +t2-dispatch-alist+ - '((compiler-let . t2compiler-let) + '((si:compiler-let . t2compiler-let) (progn . t2progn) (ordinary . t2ordinary) (load-time-value . t2load-time-value) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 614e99700..3d5c438a9 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -517,7 +517,7 @@ keyword argument, the compiler-macro declines to provide an expansion. (setq lambda-list (nconc (ldiff lambda-list env) (cddr env)))) ;; 2. parse the remaining lambda-list (multiple-value-bind (reqs opts rest key-flag keywords allow-other-keys auxs) - (si::process-lambda-list lambda-list 'si::macro) + (si::process-lambda-list lambda-list 'si:macro) (when (and rest (or key-flag allow-other-keys)) (error "define-compiler-macro* can't deal with lambda-lists with both &key and &rest arguments")) ;; utility functions diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 97d663b0f..849258d6c 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -46,19 +46,19 @@ (defun parse-function-proclamation (name arg-types return-type &rest properties) - (when (sys:get-sysprop name 'proclaimed-arg-types) + (when (si:get-sysprop name 'proclaimed-arg-types) (warn "Duplicate proclamation for ~A" name)) (proclaim-function name (list arg-types return-type)) (loop for p in properties do (case p (:no-sp-change - (sys:put-sysprop name 'no-sp-change t)) + (si:put-sysprop name 'no-sp-change t)) ((:predicate :pure) - (sys:put-sysprop name 'pure t) - (sys:put-sysprop name 'no-side-effects t)) + (si:put-sysprop name 'pure t) + (si:put-sysprop name 'no-side-effects t)) ((:no-side-effects :reader) - (sys:put-sysprop name 'no-side-effects t)) + (si:put-sysprop name 'no-side-effects t)) (otherwise (error "Unknown property ~S in function proclamation for ~S" p name)))))