diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-21 12:27:55 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-21 12:27:55 +0200 |
| commit | 2e85d07ffcfda35d3ba2adf3778303d37adc751c (patch) | |
| tree | 67e5f63af8663ae48950520baf9deb7e5fe6405e | |
| parent | 7c2f344105e0b52e4bbf5432d16a8f1f22f0ebb2 (diff) | |
SETQ, PREPARE-REF: Handle constants appropriately.
| -rw-r--r-- | sb-eval2.lisp | 26 |
1 files changed, 19 insertions, 7 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index ed20b7a..cea08b2 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -278,13 +278,17 @@ (env-lexical (lambda (env) (environment-value env nesting offset))))) - (progn - (assume-special context var) - (lambda (env) - (declare (ignore env)) - (unless (boundp var) - (error 'unbound-variable :name var)) - (symbol-value var))))) + (if (globally-constant-p var) + (lambda (env) + (declare (ignore env)) + (symbol-value var)) + (progn + (assume-special context var) + (lambda (env) + (declare (ignore env)) + (unless (boundp var) + (error 'unbound-variable :name var)) + (symbol-value var)))))) (defun body-decls&forms (exprs) @@ -724,6 +728,9 @@ (defun globally-special-p (var) (eq :special (sb-int:info :variable :kind var))) +(defun globally-constant-p (var) + (eq :constant (sb-int:info :variable :kind var))) + (defun assume-special (context var) (unless (or (globally-special-p var) (context-var-special-p context var)) @@ -731,6 +738,10 @@ :format-control "Undefined variable: ~S" :format-arguments (list var)))) +(defun prevent-constant-modification (var) + (when (globally-constant-p var) + (error "~S is a constant and thus can't be set." var))) + (defvar *mode* :not-compile-time) (declaim (ftype (function (* context &optional symbol) eval-closure) prepare-form)) @@ -787,6 +798,7 @@ (context-find-lexical context var)) (t (assume-special context var) + (prevent-constant-modification var) :special)) collect (prepare-form valform context)))) (lambda (env) |