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

Proclamations now propagate to all global variables.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-12-08 11:49:32 +01:00
parent ac40a4649b
commit 522d139f4e
2 changed files with 13 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -115,16 +115,13 @@
(defun proclaim-var (type vl)
(dolist (var vl)
(if (symbolp var)
(let ((type1 (get-sysprop var 'CMP-TYPE))
(v (sch-global var)))
(let ((type1 (get-sysprop var 'CMP-TYPE)))
(setq type1 (if type1 (type-and type1 type) type))
(when v (setq type1 (type-and type1 (var-type v))))
(unless type1
(warn
"Inconsistent type declaration was found for the variable ~s."
var)
(setq type1 T))
(put-sysprop var 'CMP-TYPE type1)
(when v (setf (var-type v) type1)))
(put-sysprop var 'CMP-TYPE type1))
(warn "The variable name ~s is not a symbol." var))))

23
src/cmp/cmpvar.lsp
View file

@ -124,12 +124,6 @@
;;; that the variable has a value.
;;; Bootstrap problem: proclaim needs this function:
(defun sch-global (name)
(dolist (var *undefined-vars*)
(declare (type var var))
(when (eq (var-name var) name)
(return-from sch-global var))))
;;;
;;; Check if a variable has been declared as a special variable with a global
;;; value.
@ -319,15 +313,20 @@
;;; ----------------------------------------------------------------------
(defun c1make-global-variable (name &key (type t) (kind 'GLOBAL) (warn nil))
(let ((var (find name *global-var-objects* :key #'var-name)))
(unless var
(setf var (make-var :name name :kind kind :type type :loc (add-symbol name))))
(push var *global-var-objects*)
(defun c1make-global-variable (name &key
(type (or (get-sysprop name 'CMP-TYPE) t))
(kind 'GLOBAL)
(warn nil))
(let* ((var (find name *global-var-objects* :key #'var-name))
(found var))
(unless found
(setf var (make-var :name name :kind kind :type type :loc (add-symbol name)))
(push var *global-var-objects*))
(when warn
(unless (or (constantp name) (special-variable-p name))
(undefined-variable name)
(push var *undefined-vars*)))
(unless found
(push var *undefined-vars*))))
var))
(defun c1declare-specials (globals)