X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmacros.lisp;h=5de7562e10e13b261259793f3e60d2ab60b2d9ca;hb=cfb9e3640e34706acdfccd26236024de259f3b4f;hp=119ae160aeb9f69dd887005c1c54a32ed65a1c75;hpb=2abf77f6c4c559a3e5b7fc351a4743305381feb6;p=sbcl.git diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp index 119ae16..5de7562 100644 --- a/src/pcl/macros.lisp +++ b/src/pcl/macros.lisp @@ -27,48 +27,44 @@ (in-package "SB-PCL") (declaim (declaration - ;; FIXME: Since none of these are supported in SBCL, the - ;; declarations using them are just noise now that this is - ;; not a portable package any more, and could be deleted. - values ; I use this so that Zwei can remind - ; me what values a function returns. - arglist ; Tells me what the pretty arglist - ; of something (which probably takes - ; &REST args) is. - indentation ; Tells ZWEI how to indent things - ; like DEFCLASS. - class - variable-rebinding - pcl-fast-call - method-name - method-lambda-list)) - -;;; These are age-old functions which CommonLisp cleaned-up away. They -;;; probably exist in other packages in all CommonLisp -;;; implementations, but I will leave it to the compiler to optimize -;;; into calls to them. + ;; These three nonstandard declarations seem to be used + ;; privately within PCL itself to pass information around, + ;; so we can't just delete them. + %class + %method-name + %method-lambda-list + ;; This declaration may also be used within PCL to pass + ;; information around, I'm not sure. -- WHN 2000-12-30 + %variable-rebinding)) + +;;; comment from CMU CL PCL: +;;; These are age-old functions which CommonLisp cleaned-up away. They +;;; probably exist in other packages in all CommonLisp +;;; implementations, but I will leave it to the compiler to optimize +;;; into calls to them. ;;; -;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we should -;;; use those. POSQ and NEQ aren't defined in SBCL, and are used too often -;;; in PCL to make it appealing to hand expand all uses and then delete -;;; the macros, so they should be boosted up to SBCL to stand by MEMQ, -;;; ASSQ, and DELQ. +;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we +;;; should use those definitions. POSQ and NEQ aren't defined in SBCL, +;;; and are used too often in PCL to make it appealing to hand expand +;;; all uses and then delete the macros, so they should be boosted up +;;; to SB-INT to stand by MEMQ, ASSQ, and DELQ. (defmacro memq (item list) `(member ,item ,list :test #'eq)) (defmacro assq (item list) `(assoc ,item ,list :test #'eq)) (defmacro delq (item list) `(delete ,item ,list :test #'eq)) (defmacro posq (item list) `(position ,item ,list :test #'eq)) (defmacro neq (x y) `(not (eq ,x ,y))) - -;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0, -;;; and boost them up to SB-INT. -(defun true (&rest ignore) (declare (ignore ignore)) t) -(defun false (&rest ignore) (declare (ignore ignore)) nil) -(defun zero (&rest ignore) (declare (ignore ignore)) 0) - -;;; ONCE-ONLY does the same thing as it does in zetalisp. I should -;;; have just lifted it from there but I am honest. Not only that but -;;; this one is written in Common Lisp. I feel a lot like -;;; bootstrapping, or maybe more like rebuilding Rome. +;;; FIXME: CONSTANTLY-FOO should be boosted up to SB-INT too. +(macrolet ((def-constantly-fun (name constant-expr) + `(setf (symbol-function ',name) + (constantly ,constant-expr)))) + (def-constantly-fun constantly-t t) + (def-constantly-fun constantly-nil nil) + (def-constantly-fun constantly-0 0)) + +;;; comment from original CMU CL PCL: ONCE-ONLY does the same thing as +;;; it does in zetalisp. I should have just lifted it from there but I +;;; am honest. Not only that but this one is written in Common Lisp. I +;;; feel a lot like bootstrapping, or maybe more like rebuilding Rome. ;;; ;;; FIXME: We should only need one ONCE-ONLY in SBCL, and there's one ;;; in SB-INT already. Can we use only one of these in both places? @@ -130,8 +126,6 @@ body))) ) ; EVAL-WHEN -;;; FIXME: This seems to only be used to get 'METHOD-NAME and -;;; METHOD-LAMBDA-LIST declarations. They aren't ANSI. Are they important? (defun get-declaration (name declarations &optional default) (dolist (d declarations default) (dolist (form (cdr d)) @@ -171,50 +165,15 @@ (setq ,var (pop .dolist-carefully.)) ,@body) (,improper-list-handler))))) - -;;; FIXME: Do we really need this? It seems to be used only -;;; for class names. Why not just the default ALL-CAPS? -(defun capitalize-words (string &optional (dashes-p t)) - (let ((string (copy-seq (string string)))) - (declare (string string)) - (do* ((flag t flag) - (length (length string) length) - (char nil char) - (i 0 (+ i 1))) - ((= i length) string) - (setq char (elt string i)) - (cond ((both-case-p char) - (if flag - (and (setq flag (lower-case-p char)) - (setf (elt string i) (char-upcase char))) - (and (not flag) (setf (elt string i) (char-downcase char)))) - (setq flag nil)) - ((char-equal char #\-) - (setq flag t) - (unless dashes-p (setf (elt string i) #\space))) - (t (setq flag nil)))))) ;;;; FIND-CLASS ;;;; -;;;; This is documented in the CLOS specification. -;;;; KLUDGE: Except that SBCL deviates from the spec by having CL:FIND-CLASS -;;;; distinct from PCL:FIND-CLASS, alas. -- WHN 19991203 +;;;; This is documented in the CLOS specification. FIXME: Except that +;;;; SBCL deviates from the spec by having CL:FIND-CLASS distinct from +;;;; PCL:FIND-CLASS, alas. (defvar *find-class* (make-hash-table :test 'eq)) -(defun make-constant-function (value) - #'(lambda (object) - (declare (ignore object)) - value)) - -(defun function-returning-nil (x) - (declare (ignore x)) - nil) - -(defun function-returning-t (x) - (declare (ignore x)) - t) - (defmacro find-class-cell-class (cell) `(car ,cell)) @@ -226,7 +185,7 @@ (defmacro make-find-class-cell (class-name) (declare (ignore class-name)) - '(list* nil #'function-returning-nil nil)) + '(list* nil #'constantly-nil nil)) (defun find-class-cell (symbol &optional dont-create-p) (or (gethash symbol *find-class*)