From: Matt Birkholz Date: Tue, 18 Jan 2011 18:54:07 +0000 (-0700) Subject: Get values of simple variables via slot accessor. X-Git-Tag: 20110609-ELisp~4 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=758560ed35fe52347f9f42574c251e0c11d7bf67;p=mit-scheme.git Get values of simple variables via slot accessor. Simple variables have no Edwin variable (e.g. buffer-local value) nor other need for accessor/mutator methods. --- diff --git a/src/elisp/Symbols.scm b/src/elisp/Symbols.scm index 7e73524ff..0bf89b93e 100644 --- a/src/elisp/Symbols.scm +++ b/src/elisp/Symbols.scm @@ -59,6 +59,7 @@ Emacs symbol. |# (unparser-state/port state)))))) (name "" read-only true) (function +unbound+) + (value +unbound+) ;global value, or +not-global+ (plist '()) ;; For chaining together contents of obarray buckets. (next '()) @@ -91,8 +92,8 @@ Emacs symbol. |# ;; ;; anyway??? (define-integrable (make-%symbol name) - (%record %symbol name +unbound+ '() '() false false-procedure '() '() - '() '() '() '() '() '() '())) + (%record %symbol name +unbound+ +unbound+ '() '() false false-procedure + '() '() '() '() '() '() '() '() '())) ;;;; Exported definitions @@ -102,15 +103,9 @@ Emacs symbol. |# (%%symbol? obj))) (define +unbound+ "elisp unbound variable tag") +(define +not-global+ "elisp non-global variable") -(define-integrable (%make-symbol name) - (let ((symbol (make-%symbol name))) - ;; Don't make variable just because there's an Edwin variable with - ;; the same name. Otherwise, things could get dicey with multiple - ;; symbols with the same name -- e.g. an abbrev with the same name - ;; as an editor variable. - (%make-symbol-global! symbol) - symbol)) +(define-integrable %make-symbol make-%symbol) (declare (integrate-operator ->%symbol)) (define (->%symbol obj) @@ -166,7 +161,8 @@ Emacs symbol. |# (define (%put! symbol property value) (let ((symbol (->%symbol symbol))) - (if (eq? property Qvariable-documentation) + (if (and (eq? property Qvariable-documentation) + (eq? +not-global+ (%symbol/value symbol))) ((%symbol/set-docstring! symbol) value)) (let loop ((plist (%symbol/plist symbol))) (cond ((null? plist) @@ -188,32 +184,97 @@ Emacs symbol. |# (define-integrable (%set-symbol-command! sym com) (set-%symbol/command! (->%symbol sym) com)) -(define-integrable (%symbol-bound? symbol) - ((%symbol/bound? (->%symbol symbol)))) - -(define-integrable (%set-symbol-unbound! symbol) - ((%symbol/unbound! (->%symbol symbol)))) - -(define-integrable (%symbol-value symbol) - ((%symbol/get-value (->%symbol symbol)))) - -(define-integrable (%set-symbol-value! symbol value) - ((%symbol/set-value! (->%symbol symbol)) value)) - -(define-integrable (%symbol-default symbol) - ((%symbol/get-default (->%symbol symbol)))) +(declare (integrate-operator %symbol-bound?)) +(define (%symbol-bound? symbol) + (if (%%symbol? symbol) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +unbound+) false) + ((eq? %value +not-global+) ((%symbol/bound? symbol))) + (else true))) + ;; Assume it's the empty list. + true)) + +(declare (integrate-operator %set-symbol-unbound!)) +(define (%set-symbol-unbound! symbol) + (if (%%symbol? symbol) + (if (eq? symbol Qt) + (error:%signal Qsetting-constant (list Qt)) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +not-global+) + ((%symbol/unbound! symbol))) + (else (set-%symbol/value! symbol +unbound+))))) + ;; Assume it's the empty list. + (error:%signal Qsetting-constant (list '())))) + +(declare (integrate-operator %symbol-value)) +(define (%symbol-value symbol) + (if (%%symbol? symbol) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +not-global+) ((%symbol/get-value symbol))) + ((eq? %value +unbound+) + (error:%signal Qvoid-variable (list symbol))) + (else %value))) + ;; Assume it's the empty list. + '())) -(define-integrable (%set-symbol-default! symbol value) - ((%symbol/set-default! (->%symbol symbol)) value)) +(declare (integrate-operator %set-symbol-value!)) +(define (%set-symbol-value! symbol value) + (if (%%symbol? symbol) + (if (eq? symbol Qt) + (error:%signal Qsetting-constant (list Qt)) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +not-global+) + ((%symbol/set-value! symbol) value)) + (else (set-%symbol/value! symbol value))))) + ;; Assume it's the empty list. + (error:%signal Qsetting-constant (list '())))) + +(declare (integrate-operator %symbol-default)) +(define (%symbol-default symbol) + (if (%%symbol? symbol) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +not-global+) ((%symbol/get-default symbol))) + ((eq? %value +unbound+) + (error:%signal Qvoid-variable (list symbol))) + (else %value))) + ;; Assume it's the empty list. + '())) -(define-integrable (%make-variable-buffer-local! symbol) - ((%symbol/make-all-local! (->%symbol symbol)))) +(define (%set-symbol-default! symbol value) + (if (%%symbol? symbol) + (if (eq? symbol Qt) + (error:%signal Qsetting-constant (list Qt)) + (let ((%value (%symbol/value symbol))) + (cond ((eq? %value +not-global+) + ((%symbol/set-default! symbol) value)) + (else (set-%symbol/value! symbol value))))) + ;; Assume it's the empty list. + (error:%signal Qsetting-constant (list '())))) + +(define (%make-variable-buffer-local! symbol) + (if (and (%%symbol? symbol) + (not (eq? symbol Qt))) + (begin + (if (not (eq? +not-global+ (%symbol/value symbol))) + (%make-symbol-variable! symbol)) + ((%symbol/make-all-local! symbol)))) + unspecific) -(define-integrable (%make-local-variable! symbol) - ((%symbol/make-local! (->%symbol symbol)))) +(define (%make-local-variable! symbol) + (if (and (%%symbol? symbol) + (not (eq? symbol Qt))) + (begin + (if (not (eq? +not-global+ (%symbol/value symbol))) + (%make-symbol-variable! symbol)) + ((%symbol/make-local! symbol)))) + unspecific) -(define-integrable (%kill-local-variable! symbol) - ((%symbol/kill-local! (->%symbol symbol)))) +(define (%kill-local-variable! symbol) + (if (and (%%symbol? symbol) + (not (eq? symbol Qt)) + (eq? +not-global+ (%symbol/value symbol))) + ((%symbol/kill-local! symbol))) + unspecific) ;;;; Obarrays @@ -280,55 +341,6 @@ Emacs symbol. |# ;;;; Coercion procedures. -(define (%make-symbol-global! symbol) - (let* ((bound? (%symbol-bound? symbol)) - (value (if bound? (%symbol-default symbol) '()))) - (let ((bound? - (lambda () - bound?)) - (unbound! - (lambda () - (set! bound? false) - unspecific)) - (get-value - (lambda () - (if bound? - value - (error:%signal Qvoid-variable (list (%symbol-> symbol)))))) - (set-value! - (lambda (new-value) - (set! bound? true) - (set! value new-value) - unspecific)) - (make-local! - (lambda () - (%make-symbol-variable! symbol) - ((%symbol/make-local! symbol)) - unspecific)) - (make-all-local! - (lambda () - (%make-symbol-variable! symbol) - ((%symbol/make-all-local! symbol)) - unspecific)) - (kill-local! - (lambda () - unspecific)) - (set-docstring! - (lambda (string) - string - unspecific))) - (set-%symbol/bound?! symbol bound?) - (set-%symbol/unbound!! symbol unbound!) - (set-%symbol/get-value! symbol get-value) - (set-%symbol/set-value!! symbol set-value!) - (set-%symbol/get-default! symbol get-value) - (set-%symbol/set-default!! symbol set-value!) - (set-%symbol/make-local!! symbol make-local!) - (set-%symbol/make-all-local!! symbol make-all-local!) - (set-%symbol/kill-local!! symbol kill-local!) - (set-%symbol/set-docstring!! symbol set-docstring!) - unspecific))) - (define (%make-symbol-variable! symbol) (let* ((existing-variable (string-table-get editor-variables (%symbol-name symbol))) @@ -428,6 +440,7 @@ Emacs symbol. |# variable-index:description docstring)) unspecific))) + (set-%symbol/value! symbol +not-global+) (set-%symbol/bound?! symbol bound?) (set-%symbol/unbound!! symbol unbound!) (set-%symbol/get-value! symbol get-value) @@ -440,6 +453,7 @@ Emacs symbol. |# (set-%symbol/set-docstring!! symbol set-docstring!)))) (define (%make-symbol-generic! symbol get-value set-value!) + (set-%symbol/value! symbol +not-global+) (set-%symbol/bound?! symbol true-procedure) (set-%symbol/unbound!! symbol false-procedure) (set-%symbol/get-value! symbol get-value) @@ -511,33 +525,13 @@ Emacs symbol. |# (let ((Qnil (%%intern "nil" initial-obarray (string-hash-mod "nil" (vector-length initial-obarray))))) - ((%symbol/set-value! Qnil) '()) - (set-%symbol/unbound!! - Qnil (lambda (val) val (error:%signal Qsetting-constant (list '())))) - (set-%symbol/set-value!! - Qnil (lambda (val) val (error:%signal Qsetting-constant (list '())))) - (set-%symbol/set-default!! - Qnil (lambda (val) val (error:%signal Qsetting-constant (list '())))) - (set-%symbol/make-local!! Qnil false-procedure) - (set-%symbol/make-all-local!! Qnil false-procedure) - (set-%symbol/kill-local!! Qnil false-procedure) - (set-%symbol/set-docstring!! Qnil false-procedure) + (set-%symbol/value! Qnil '()) Qnil)) (define Qt (let ((Qt (%%intern "t" initial-obarray (string-hash-mod "t" (vector-length initial-obarray))))) - ((%symbol/set-value! Qt) Qt) - (set-%symbol/unbound!! - Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt)))) - (set-%symbol/set-value!! - Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt)))) - (set-%symbol/set-default!! - Qt (lambda (val) val (error:%signal Qsetting-constant (list Qt)))) - (set-%symbol/make-local!! Qt false-procedure) - (set-%symbol/make-all-local!! Qt false-procedure) - (set-%symbol/kill-local!! Qt false-procedure) - (set-%symbol/set-docstring!! Qt false-procedure) + (set-%symbol/value! Qt Qt) Qt)) (define Qsetting-constant diff --git a/src/elisp/elisp.pkg b/src/elisp/elisp.pkg index 0972446a5..47c3f99ed 100644 --- a/src/elisp/elisp.pkg +++ b/src/elisp/elisp.pkg @@ -92,6 +92,7 @@ Copyright (c) 1993 Matthew Birkholz, All Rights Reserved |# (export (elisp) %symbol ;record type, used by inlined %symbol? +unbound+ ;constant, used by %symbol-fbound?... + +not-global+ ;constant, used by %symbol-value... %symbol? %make-symbol %symbol-name @@ -118,7 +119,6 @@ Copyright (c) 1993 Matthew Birkholz, All Rights Reserved |# %intern %intern-soft %for-symbol - %make-symbol-global! ;procedure, used by %make-symbol %make-symbol-variable! %make-symbol-generic! boolean-getter