X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsymbol.lisp;h=437e199532a842105f000091ae3239d03f2393d6;hb=4ae1b794a5d6a90794468cf8017f5307f2c30dfe;hp=c0292ac763e919d567758449a743828e8be9163f;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index c0292ac..437e199 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -15,82 +15,81 @@ (in-package "SB!IMPL") -(file-comment - "$Header$") - (declaim (maybe-inline get %put getf remprop %putf get-properties keywordp)) -(defun symbol-value (variable) +(defun symbol-value (symbol) #!+sb-doc - "VARIABLE must evaluate to a symbol. This symbol's current special - value is returned." + "Return SYMBOL's current bound value." (declare (optimize (safety 1))) - (symbol-value variable)) + (symbol-value symbol)) -(defun boundp (variable) +(defun boundp (symbol) #!+sb-doc - "VARIABLE must evaluate to a symbol. Return NIL if this symbol is - unbound, T if it has a value." - (boundp variable)) + "Return non-NIL if SYMBOL is bound to a value." + (boundp symbol)) -(defun set (variable new-value) +(defun set (symbol new-value) #!+sb-doc - "VARIABLE must evaluate to a symbol. This symbol's special value cell is - set to the specified new value." - (declare (type symbol variable)) - (cond ((null variable) - (error "Nihil ex nihil, NIL can't be set.")) - ((eq variable t) - (error "Veritas aeterna, T can't be set.")) - ((and (boundp '*keyword-package*) - (keywordp variable)) - (error "Keywords can't be set.")) - (t - (%set-symbol-value variable new-value)))) + "Set SYMBOL's value cell to NEW-VALUE." + (declare (type symbol symbol)) + (about-to-modify-symbol-value symbol) + (%set-symbol-value symbol new-value)) (defun %set-symbol-value (symbol new-value) (%set-symbol-value symbol new-value)) -(defun makunbound (variable) +(defun makunbound (symbol) #!+sb-doc - "VARIABLE must evaluate to a symbol. This symbol is made unbound, - removing any value it may currently have." - (set variable - (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-type)) - variable) - + "Make SYMBOL unbound, removing any value it may currently have." + (set symbol + (%primitive sb!c:make-other-immediate-type + 0 + sb!vm:unbound-marker-widetag)) + symbol) + +;;; Return the built-in hash value for SYMBOL. + +;;; only backends for which a SYMBOL-HASH vop exists. In the past, +;;; when the MIPS backend supported (or nearly did) a generational +;;; (non-conservative) garbage collector, this read (OR X86 MIPS). +;;; Having excised the vestigial support for GENGC, this now only +;;; applies for the x86 port, but if someone were to rework the GENGC +;;; support, this might change again. -- CSR, 2002-08-26 +#!+x86 (defun symbol-hash (symbol) - #!+sb-doc - "Return the built-in hash value for symbol." (symbol-hash symbol)) -(defun symbol-function (variable) +;;; Compute the hash value for SYMBOL. +#!-x86 +(defun symbol-hash (symbol) + (%sxhash-simple-string (symbol-name symbol))) + +(defun symbol-function (symbol) #!+sb-doc - "VARIABLE must evaluate to a symbol. This symbol's current definition - is returned. Settable with SETF." - (raw-definition variable)) + "Return SYMBOL's current function definition. Settable with SETF." + (%coerce-name-to-fun symbol)) -(defun fset (symbol new-value) +(defun (setf symbol-function) (new-value symbol) (declare (type symbol symbol) (type function new-value)) - (setf (raw-definition symbol) new-value)) + (setf (%coerce-name-to-fun symbol) new-value)) -(defun symbol-plist (variable) +(defun symbol-plist (symbol) #!+sb-doc - "Return the property list of a symbol." - (symbol-plist variable)) + "Return SYMBOL's property list." + (symbol-plist symbol)) (defun %set-symbol-plist (symbol new-value) (setf (symbol-plist symbol) new-value)) -(defun symbol-name (variable) +(defun symbol-name (symbol) #!+sb-doc - "Return the print name of a symbol." - (symbol-name variable)) + "Return SYMBOL's name as a string." + (symbol-name symbol)) -(defun symbol-package (variable) +(defun symbol-package (symbol) #!+sb-doc - "Return the package a symbol is interned in, or NIL if none." - (symbol-package variable)) + "Return the package SYMBOL was interned in, or NIL if none." + (symbol-package symbol)) (defun %set-symbol-package (symbol package) (declare (type symbol symbol)) @@ -99,8 +98,7 @@ (defun make-symbol (string) #!+sb-doc "Make and return a new symbol with the STRING as its print name." - #!-gengc (make-symbol string) - #!+gengc (%make-symbol (random most-positive-fixnum) string)) + (make-symbol string)) (defun get (symbol indicator &optional (default nil)) #!+sb-doc @@ -153,9 +151,8 @@ (defun getf (place indicator &optional (default ())) #!+sb-doc - "Searches the property list stored in Place for an indicator EQ to Indicator. - If one is found, the corresponding value is returned, else the Default is - returned." + "Search the property list stored in Place for an indicator EQ to INDICATOR. + If one is found, return the corresponding value, else return DEFAULT." (do ((plist place (cddr plist))) ((null plist) default) (cond ((atom (cdr plist)) @@ -175,8 +172,8 @@ (defun get-properties (place indicator-list) #!+sb-doc - "Like GETF, except that Indicator-List is a list of indicators which will - be looked for in the property list stored in Place. Three values are + "Like GETF, except that INDICATOR-LIST is a list of indicators which will + be looked for in the property list stored in PLACE. Three values are returned, see manual for details." (do ((plist place (cddr plist))) ((null plist) (values nil nil nil)) @@ -203,11 +200,12 @@ (setf (symbol-function new-symbol) (symbol-function symbol)))) new-symbol) +;;; FIXME: This declaration should be redundant. (declaim (special *keyword-package*)) (defun keywordp (object) #!+sb-doc - "Returns true if Object is a symbol in the keyword package." + "Return true if Object is a symbol in the \"KEYWORD\" package." (and (symbolp object) (eq (symbol-package object) *keyword-package*))) @@ -247,9 +245,9 @@ (defvar *gentemp-counter* 0) (declaim (type unsigned-byte *gentemp-counter*)) -(defun gentemp (&optional (prefix "T") (package *package*)) +(defun gentemp (&optional (prefix "T") (package (sane-package))) #!+sb-doc - "Creates a new symbol interned in package Package with the given Prefix." + "Creates a new symbol interned in package PACKAGE with the given PREFIX." (declare (type string prefix)) (loop (let ((*print-base* 10)