X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsymbol.lisp;h=58f3fc19d0b600575400af25881edce04fbbcaa2;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=ab82c19e96d78c2177cb3d50809a3bee05db3a69;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index ab82c19..58f3fc1 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -15,7 +15,7 @@ (in-package "SB!IMPL") -(declaim (maybe-inline get %put getf remprop %putf get-properties keywordp)) +(declaim (maybe-inline get get2 get3 %put getf remprop %putf get-properties keywordp)) (defun symbol-value (symbol) #!+sb-doc @@ -32,20 +32,23 @@ #!+sb-doc "Set SYMBOL's value cell to NEW-VALUE." (declare (type symbol symbol)) - (about-to-modify-symbol-value symbol) + (about-to-modify-symbol-value symbol "set SYMBOL-VALUE of ~S" new-value) (%set-symbol-value symbol new-value)) (defun %set-symbol-value (symbol new-value) (%set-symbol-value symbol new-value)) +(declaim (inline %makunbound)) +(defun %makunbound (symbol) + (%set-symbol-value symbol (%primitive sb!c:make-other-immediate-type + 0 sb!vm:unbound-marker-widetag))) + (defun makunbound (symbol) #!+sb-doc "Make SYMBOL unbound, removing any value it may currently have." (with-single-package-locked-error (:symbol symbol "unbinding the symbol ~A") - (set symbol - (%primitive sb!c:make-other-immediate-type - 0 - sb!vm:unbound-marker-widetag)) + (about-to-modify-symbol-value symbol "make ~S unbound") + (%makunbound symbol) symbol)) ;;; Return the built-in hash value for SYMBOL. @@ -88,19 +91,41 @@ (defun make-symbol (string) #!+sb-doc "Make and return a new symbol with the STRING as its print name." - (make-symbol string)) + (declare (type string string)) + (%make-symbol (if (simple-string-p string) + string + (subseq string 0)))) (defun get (symbol indicator &optional (default nil)) #!+sb-doc "Look on the property list of SYMBOL for the specified INDICATOR. If this is found, return the associated value, else return DEFAULT." - (do ((pl (symbol-plist symbol) (cddr pl))) - ((atom pl) default) - (cond ((atom (cdr pl)) - (error "~S has an odd number of items in its property list." - symbol)) - ((eq (car pl) indicator) - (return (cadr pl)))))) + (get3 symbol indicator default)) + +(defun get2 (symbol indicator) + (get3 symbol indicator nil)) +#| + (let (cdr-pl) + (do ((pl (symbol-plist symbol) (cdr cdr-pl))) + ((atom pl) nil) + (setf cdr-pl (cdr pl)) + (cond ((atom cdr-pl) + (error "~S has an odd number of items in its property list." + symbol)) + ((eq (car pl) indicator) + (return (car cdr-pl))))))) +|# + +(defun get3 (symbol indicator default) + (let (cdr-pl) + (do ((pl (symbol-plist symbol) (cdr cdr-pl))) + ((atom pl) default) + (setq cdr-pl (cdr pl)) + (cond ((atom cdr-pl) + (error "~S has an odd number of items in its property list." + symbol)) + ((eq (car pl) indicator) + (return (car cdr-pl))))))) (defun %put (symbol indicator value) #!+sb-doc