Get values of simple variables via slot accessor.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 18 Jan 2011 18:54:07 +0000 (11:54 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 18 Jan 2011 18:54:07 +0000 (11:54 -0700)
Simple variables have no Edwin variable (e.g. buffer-local value) nor
other need for accessor/mutator methods.

src/elisp/Symbols.scm
src/elisp/elisp.pkg

index 7e73524ff43588c0d562896f1e1d833e406c3506..0bf89b93e338d75b9d98a3605bbcd63a9b472240 100644 (file)
@@ -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
+          '() '() '() '() '() '() '() '() '()))
 \f
 ;;;; 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)
 \f
 ;;;; Obarrays
 
@@ -280,55 +341,6 @@ Emacs symbol. |#
 \f
 ;;;; 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
index 0972446a58ecbb077fc890a4ede7d47c5352701a..47c3f99ed3de55a7cfb978265c095a0685d7eca1 100644 (file)
@@ -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