mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-26 06:22:33 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: don't import symbols from the SYSTEM package

Browse source 
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.
This commit is contained in:
Daniel Kochmański 2023-02-13 17:49:43 +01:00
parent edb19dcf75
commit acd1dd3c07
10 changed files with 38 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/cmp/cmpenv-api.lsp
View file

@ -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))

19
src/cmp/cmpenv-fun.lsp
View file

@ -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))))

8
src/cmp/cmpglobals.lsp
View file

@ -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

2
src/cmp/cmpmain.lsp
View file

@ -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.

6
src/cmp/cmppackage.lsp
View file

@ -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)

6
src/cmp/cmppass1-data.lsp
View file

@ -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)

6
src/cmp/cmppass2-data.lsp
View file

@ -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)))

6
src/cmp/cmptables.lsp
View file

@ -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)

2
src/cmp/cmputil.lsp
View file

@ -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

10
src/cmp/proclamations.lsp
View file

@ -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)))))