From 522d139f4ecfcfbca79bb751a9b7df678b0e0c10 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 8 Dec 2012 11:49:32 +0100 Subject: [PATCH] Proclamations now propagate to all global variables. --- src/cmp/cmpenv-proclaim.lsp | 7 ++----- src/cmp/cmpvar.lsp | 23 +++++++++++------------ 2 files changed, 13 insertions(+), 17 deletions(-) diff --git a/src/cmp/cmpenv-proclaim.lsp b/src/cmp/cmpenv-proclaim.lsp index 45efe5bef..990786df3 100644 --- a/src/cmp/cmpenv-proclaim.lsp +++ b/src/cmp/cmpenv-proclaim.lsp @@ -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)))) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index e33c1ddce..d3fa51d89 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -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)