mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-27 03:40:31 -07:00
Code Issues Projects Releases Packages Wiki Activity

cmp: refactor: qualify package of *-prop interface

Browse source 
Usage was mixed, once it is si:put-sysprop, once just put-sysprop. Add
full package qualifiers to put-sysprop/get-sysprop/rem-sysprop.
This commit is contained in:
Daniel Kochmanski 2017-04-28 11:48:15 +02:00
parent a22424c3db
commit 15640a79e4
16 changed files with 38 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/cmp/cmpcall.lsp
View file

@ -139,7 +139,7 @@
;; either because it has been proclaimed so, or because it belongs
;; to the runtime.
(when (policy-use-direct-C-call)
(let ((fd (get-sysprop fname 'Lfun)))
(let ((fd (si:get-sysprop fname 'Lfun)))
(when fd
(multiple-value-bind (minarg maxarg) (get-proclaimed-narg fname)
(return-from call-global-loc

2
src/cmp/cmpcbk.lsp
View file

@ -40,7 +40,7 @@
(c1expr
`(progn
(defun ,name ,(reverse arg-variables) ,@body)
(si::put-sysprop ',name :callback
(si:put-sysprop ',name :callback
(list
(ffi:c-inline () () :object
,(format nil "ecl_make_foreign_data(@':pointer-void,0,(void*)~a)" c-name)

4
src/cmp/cmpenv-declare.lsp
View file

@ -26,9 +26,9 @@
(every test x))))
(defun type-name-p (name)
(or (get-sysprop name 'SI::DEFTYPE-DEFINITION)
(or (si:get-sysprop name 'SI::DEFTYPE-DEFINITION)
(find-class name nil)
(get-sysprop name 'SI::STRUCTURE-TYPE)))
(si:get-sysprop name 'SI::STRUCTURE-TYPE)))
(defun validate-alien-declaration (names-list error)
(dolist (new-declaration names-list)

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

@ -46,12 +46,12 @@
(when (eq arg-types '())
(setf arg-types '(&optional)))
(if (eq arg-types '*)
(rem-sysprop fname 'PROCLAIMED-ARG-TYPES)
(put-sysprop fname 'PROCLAIMED-ARG-TYPES arg-types))
(si:rem-sysprop fname 'PROCLAIMED-ARG-TYPES)
(si:put-sysprop fname 'PROCLAIMED-ARG-TYPES arg-types))
(if (member return-types '(* (VALUES &rest t))
:test #'equalp)
(rem-sysprop fname 'PROCLAIMED-RETURN-TYPE)
(put-sysprop fname 'PROCLAIMED-RETURN-TYPE return-types)))
(si:rem-sysprop fname 'PROCLAIMED-RETURN-TYPE)
(si:put-sysprop fname 'PROCLAIMED-RETURN-TYPE return-types)))
(warn "The function proclamation ~s ~s is not valid." fname decl)))
(defun add-function-declaration (fname ftype &optional (env *cmp-env*))
@ -174,5 +174,5 @@
(c::declare-inline ',fname *cmp-env-root* ',form)))
,(when proclaimed
`(eval-when (:compile-toplevel :load-toplevel :execute)
(si::put-sysprop ',fname 'inline ',form))))))
(si:put-sysprop ',fname 'inline ',form))))))

10
src/cmp/cmpenv-proclaim.lsp
View file

@ -83,12 +83,12 @@
(si::mangle-name x t)
(if found
(warn "The function ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." x)
(put-sysprop x 'Lfun c-name))))
(si:put-sysprop x 'Lfun c-name))))
((consp x)
(destructuring-bind (c-name lisp-name) x
(if (si::mangle-name lisp-name)
(warn "The funciton ~s is already in the runtime.~%C-EXPORT-FNAME declaration ignored." lisp-name)
(put-sysprop lisp-name 'Lfun c-name))))
(si:put-sysprop lisp-name 'Lfun c-name))))
(t
(error "Syntax error in proclamation ~s" decl)))))
((ARRAY ATOM BASE-CHAR BIGNUM BIT BIT-VECTOR CHARACTER COMPILED-FUNCTION
@ -106,7 +106,7 @@
(proclaim-var type (rest decl))
t)))
((maybe-add-policy decl *cmp-env-root*))
((let ((proclaimer (get-sysprop (car decl) :proclaim)))
((let ((proclaimer (si:get-sysprop (car decl) :proclaim)))
(when (functionp proclaimer)
(mapc proclaimer (rest decl))
t)))
@ -116,13 +116,13 @@
(defun proclaim-var (type vl)
(dolist (var vl)
(if (symbolp var)
(let ((type1 (get-sysprop var 'CMP-TYPE)))
(let ((type1 (si:get-sysprop var 'CMP-TYPE)))
(setq type1 (if type1 (type-and type1 type) type))
(unless type1
(warn
"Inconsistent type declaration was found for the variable ~s."
var)
(setq type1 T))
(put-sysprop var 'CMP-TYPE type1))
(si:put-sysprop var 'CMP-TYPE type1))
(warn "The variable name ~s is not a symbol." var))))

2
src/cmp/cmpeval.lsp
View file

@ -141,7 +141,7 @@
)))
(defun c1call-constant-fold (fname forms)
(when (and (get-sysprop fname 'pure)
(when (and (si:get-sysprop fname 'pure)
(policy-evaluate-forms)
(inline-possible fname))
(handler-case

6
src/cmp/cmpinline.lsp
View file

@ -192,8 +192,8 @@
(some #'c1form-side-effects forms))
(defun function-may-have-side-effects (fname)
(not (get-sysprop fname 'no-side-effects)))
(not (si:get-sysprop fname 'no-side-effects)))
(defun function-may-change-sp (fname)
(not (or (get-sysprop fname 'no-side-effects)
(get-sysprop fname 'no-sp-change))))
(not (or (si:get-sysprop fname 'no-side-effects)
(si:get-sysprop fname 'no-sp-change))))

2
src/cmp/cmpopt-cons.lsp
View file

@ -28,7 +28,7 @@
(defun simple-optimizer-function (name args inline-form)
(declare (si::c-local))
(si::put-sysprop
(si:put-sysprop
name 'si::compiler-macro
(if (every #'symbolp args)
#'(lambda (whole env)

2
src/cmp/cmpopt-constant.lsp
View file

@ -21,7 +21,7 @@
(and (consp form)
(let ((head (car form)))
(or (member head '(IF OR AND NULL NOT PROGN))
(and (get-sysprop head 'pure)
(and (si:get-sysprop head 'pure)
(inline-possible head))))
(loop for c in (rest form)
always (constant-expression-p c env)))))

8
src/cmp/cmpopt.lsp
View file

@ -70,7 +70,7 @@
form)
;;
;; There exists a function which checks for this type?
((setf function (get-sysprop type 'si::type-predicate))
((setf function (si:get-sysprop type 'si::type-predicate))
`(,function ,object))
;;
;; Similar as before, but we assume the user did not give us
@ -81,7 +81,7 @@
;;
;; Complex types defined with DEFTYPE.
((and (atom type)
(setq function (get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(setq function (si:get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(expand-typep form object `',(funcall function nil) env))
;;
;; No optimizations that take up too much space unless requested.
@ -148,7 +148,7 @@
`(,function ,object))
;;
;; Complex types with arguments.
((setf function (get-sysprop first 'SI::DEFTYPE-DEFINITION))
((setf function (si:get-sysprop first 'SI::DEFTYPE-DEFINITION))
(expand-typep form object `',(funcall function rest) env))
(t
form))))
@ -255,7 +255,7 @@
;;
;; Complex types defined with DEFTYPE.
((and (atom type)
(setq first (get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(setq first (si:get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(expand-coerce form value `',(funcall first nil) env))
;;
;; CONS types are not coercible.

2
src/cmp/cmpspecial.lsp
View file

@ -79,7 +79,7 @@
(make-c1form* 'FUNCTION
:type 'FUNCTION
:sp-change (not (and (symbolp fun)
(get-sysprop fun 'NO-SP-CHANGE)))
(si:get-sysprop fun 'NO-SP-CHANGE)))
:args 'GLOBAL nil fun))))
((and (consp fun) (member (car fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
(cmpck (endp (cdr fun))

4
src/cmp/cmpstructures.lsp
View file

@ -22,7 +22,7 @@
;;;
(defun get-slot-type (name index)
;; default is t
(or (third (nth index (get-sysprop name 'SYS::STRUCTURE-SLOT-DESCRIPTIONS))) 'T))
(or (third (nth index (si:get-sysprop name 'SYS::STRUCTURE-SLOT-DESCRIPTIONS))) 'T))
;;;
;;; STRUCTURE SLOT READING
@ -34,7 +34,7 @@
;;;
(defun maybe-optimize-structure-access (fname args)
(let* ((slot-description (get-sysprop fname 'SYS::STRUCTURE-ACCESS)))
(let* ((slot-description (si:get-sysprop fname 'SYS::STRUCTURE-ACCESS)))
(when (and slot-description
(inline-possible fname)
(policy-inline-slot-access-p))

4
src/cmp/cmptop.lsp
View file

@ -327,7 +327,7 @@
;;; used (only once) in cmp1lam.lsp
(defun exported-fname (name)
(let (cname)
(if (and (symbolp name) (setf cname (get-sysprop name 'Lfun)))
(if (and (symbolp name) (setf cname (si:get-sysprop name 'Lfun)))
(values cname t)
(values (next-cfun "L~D~A" name) nil))))
@ -460,7 +460,7 @@
finally (wt ";"))))
(defun wt-global-entry (fname cfun arg-types return-type)
(when (and (symbolp fname) (get-sysprop fname 'NO-GLOBAL-ENTRY))
(when (and (symbolp fname) (si:get-sysprop fname 'NO-GLOBAL-ENTRY))
(return-from wt-global-entry nil))
(wt-comment-nl "global entry for the function ~a" fname)
(wt-nl "static cl_object L" cfun "(cl_narg narg")

8
src/cmp/cmputil.lsp
View file

@ -382,10 +382,10 @@
(values nil nil))))
(defun si::compiler-clear-compiler-properties (symbol)
(rem-sysprop symbol 't1)
(rem-sysprop symbol 't2)
(rem-sysprop symbol 't3)
(rem-sysprop symbol 'lfun))
(si:rem-sysprop symbol 't1)
(si:rem-sysprop symbol 't2)
(si:rem-sysprop symbol 't3)
(si:rem-sysprop symbol 'lfun))
(defun lisp-to-c-name (obj)
"Translate Lisp object prin1 representation to valid C identifier name"

8
src/cmp/cmpvar.lsp
View file

@ -156,7 +156,7 @@
(cmp-env-search-var name)
(cond ((var-p var)
(var-type var))
((get-sysprop name 'CMP-TYPE))
((si:get-sysprop name 'CMP-TYPE))
(t))))
;;;
@ -187,7 +187,7 @@
(cmperr "Special variable ~A cannot be declared to have C type ~A"
name type))
(when (eq type 'T)
(setf type (or (get-sysprop name 'CMP-TYPE) 'T)))
(setf type (or (si:get-sysprop name 'CMP-TYPE) 'T)))
(c1make-global-variable name :kind 'SPECIAL :type type))
(t
(make-var :name name :type type :loc 'OBJECT
@ -232,7 +232,7 @@
(cmp-env-search-var name)
(cond ((null var)
(c1make-global-variable name :warn t
:type (or (get-sysprop name 'CMP-TYPE) t)))
:type (or (si:get-sysprop name 'CMP-TYPE) t)))
((not (var-p var))
;; symbol-macrolet
(baboon))
@ -331,7 +331,7 @@
;;; ----------------------------------------------------------------------
(defun c1make-global-variable (name &key
(type (or (get-sysprop name 'CMP-TYPE) t))
(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))))

2
src/cmp/sysfun.lsp
View file

@ -849,7 +849,7 @@
:arg-types arg-types
:exact-return-type exact-return-type
:multiple-values multiple-values
;; :side-effects (not (get-sysprop name 'no-side-effects))
;; :side-effects (not (si:get-sysprop name 'no-side-effects))
:one-liner one-liner
:expansion expansion)))
#+(or)