From: <cli...@li...> - 2004-10-18 18:35:47
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src clos-genfun2.lisp,1.58,1.59 clos-method1.lisp,1.29,1.30 ChangeLog,1.3673,1.3674 (Bruno Haible) 2. clisp/src clos-genfun4.lisp,1.25,1.26 clos-method1.lisp,1.30,1.31 disassem.lisp,1.20,1.21 ChangeLog,1.3674,1.3675 (Bruno Haible) 3. clisp/src clos-genfun2.lisp,1.59,1.60 ChangeLog,1.3675,1.3676 (Bruno Haible) 4. clisp/src clos.lisp,1.97,1.98 (Bruno Haible) 5. clisp/src clos-class3.lisp,1.55,1.56 ChangeLog,1.3676,1.3677 (Bruno Haible) 6. clisp/src describe.lisp,1.56,1.57 ChangeLog,1.3677,1.3678 (Bruno Haible) 7. clisp/src clos-class2.lisp,1.43,1.44 (Bruno Haible) 8. clisp/src clos-class3.lisp,1.56,1.57 ChangeLog,1.3678,1.3679 (Bruno Haible) 9. clisp/src TODO,1.24,1.25 (Sam Steingold) 10. clisp/src fill-out.lisp,1.9,1.10 ChangeLog,1.3679,1.3680 (Sam Steingold) 11. clisp/src clos-print.lisp,1.13,1.14 ChangeLog,1.3680,1.3681 (Sam Steingold) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-genfun2.lisp,1.58,1.59 clos-method1.lisp,1.29,1.30 ChangeLog,1.3673,1.3674 Date: Mon, 18 Oct 2004 11:00:41 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5794/src Modified Files: clos-genfun2.lisp clos-method1.lisp ChangeLog Log Message: Move the initfunction invocation to the initializer. Index: clos-genfun2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun2.lisp,v retrieving revision 1.58 retrieving revision 1.59 diff -u -d -r1.58 -r1.59 --- clos-genfun2.lisp 15 Oct 2004 11:44:48 -0000 1.58 +++ clos-genfun2.lisp 18 Oct 2004 11:00:34 -0000 1.59 @@ -324,16 +324,7 @@ "~S: ~S already belongs to ~S, cannot also add it to ~S" 'std-add-method method (method-generic-function method) gf)) (check-method-qualifiers gf method) - (when (typep method <standard-method>) - (setf (std-method-fast-function method) nil) - ;; Determine function from initfunction: - (when (and (null (std-method-function method)) - (null (std-method-fast-function method))) - (let ((h (funcall (std-method-initfunction method) method))) - (setf (std-method-fast-function method) (car h)) - (when (car (cdr h)) ; could the variable ",cont" be optimized away? - (setf (std-method-wants-next-method-p method) nil))))) - ;; The method is finished. Now add it: + ;; The method is checked. Now add it: (warn-if-gf-already-called gf) (let ((old-method (find method (std-gf-methods gf) :test #'methods-agree-p))) (when old-method @@ -384,11 +375,7 @@ ;; Remove a method from a generic function. (defun std-remove-method (gf method) - (let ((old-method - (if (typep method <standard-method>) - (find (std-method-initfunction method) (std-gf-methods gf) - :key #'std-method-initfunction) - (find method (std-gf-methods gf))))) + (let ((old-method (find method (std-gf-methods gf)))) (when old-method (warn-if-gf-already-called gf) (when (need-gf-already-called-warning-p gf) Index: clos-method1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-method1.lisp,v retrieving revision 1.29 retrieving revision 1.30 diff -u -d -r1.29 -r1.30 --- clos-method1.lisp 15 Oct 2004 11:44:48 -0000 1.29 +++ clos-method1.lisp 18 Oct 2004 11:00:35 -0000 1.30 @@ -89,10 +89,6 @@ ;; invocation. However, for CALL-NEXT-METHOD, NO-NEXT-METHOD and ;; METHOD-GENERIC-FUNCTION the generic function must be known. So we have ;; to store a generic function backpointer in the method. -;; Now, in ANSI CL, methods do not belong to specific generic functions in -;; principle (because of ADD-METHOD); therefore we must copy the method -;; during ADD-METHOD. And during REMOVE-METHOD, we determine the identity -;; of two copies of the same method by looking at std-method-initfunction. (defun method-lambda-list-to-signature (lambda-list errfunc) (multiple-value-bind (reqvars optvars optinits optsvars rest @@ -180,6 +176,12 @@ (unless (typep wants-next-method-p 'boolean) (error (TEXT "(~S ~S): The ~S argument should be a NIL or T, not ~S") 'initialize-instance 'standard-method 'wants-next-method-p wants-next-method-p)) + ; Determine function from initfunction: + (when (and (null function) (null fast-function)) + (let ((h (funcall initfunction method))) + (setq fast-function (car h)) + (when (car (cdr h)) ; could the variable ",cont" be optimized away? + (setq wants-next-method-p nil)))) ; Check the documentation. (unless (or (null documentation) (stringp documentation)) (error (TEXT "(~S ~S): The ~S argument should be a string or NIL, not ~S") Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3673 retrieving revision 1.3674 diff -u -d -r1.3673 -r1.3674 --- ChangeLog 15 Oct 2004 19:18:40 -0000 1.3673 +++ ChangeLog 18 Oct 2004 11:00:35 -0000 1.3674 @@ -1,3 +1,12 @@ +2004-10-10 Bruno Haible <br...@cl...> + + Now that methods are never copied, move the initfunction invocation + to the initializer. + * clos-method1.lisp (initialize-instance-<standard-method>): Invoke + the initfunction here. + * clos-genfun2.lisp (std-add-method): ... not here. + (std-remove-method): Use normal identity for comparing methods. + 2004-10-15 Sam Steingold <sd...@gn...> LOAD can now restart when it encounters errors --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-genfun4.lisp,1.25,1.26 clos-method1.lisp,1.30,1.31 disassem.lisp,1.20,1.21 ChangeLog,1.3674,1.3675 Date: Mon, 18 Oct 2004 11:01:50 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6287/src Modified Files: clos-genfun4.lisp clos-method1.lisp disassem.lisp ChangeLog Log Message: Remove the initfunction slot. Index: disassem.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/disassem.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- disassem.lisp 15 Oct 2004 11:41:48 -0000 1.20 +++ disassem.lisp 18 Oct 2004 11:01:47 -0000 1.21 @@ -23,8 +23,7 @@ (disassemble (method-function object))) (:method ((object clos::standard-method) &key &allow-other-keys) (disassemble (or (clos::std-method-fast-function object) - (clos::std-method-function object))) - (disassemble (clos::std-method-initfunction object))) + (clos::std-method-function object)))) (:method ((object standard-generic-function) &key qualifiers specializers) (if (or qualifiers specializers) (disassemble (find-method object qualifiers Index: clos-genfun4.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun4.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- clos-genfun4.lisp 14 Oct 2004 12:00:51 -0000 1.25 +++ clos-genfun4.lisp 18 Oct 2004 11:01:47 -0000 1.26 @@ -330,7 +330,6 @@ :specializers (list (intern-eql-specializer gf) <t> <t>) :documentation (std-method-documentation *extended-method-check-method*) 'fast-function (std-method-fast-function *extended-method-check-method*) - 'initfunction (std-method-initfunction *extended-method-check-method*) 'wants-next-method-p (std-method-wants-next-method-p *extended-method-check-method*) 'signature (std-method-signature *extended-method-check-method*)))) Index: clos-method1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-method1.lisp,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- clos-method1.lisp 18 Oct 2004 11:00:35 -0000 1.30 +++ clos-method1.lisp 18 Oct 2004 11:01:47 -0000 1.31 @@ -66,11 +66,7 @@ ; (only for the purpose of CALL-NEXT-METHOD and ; NO-NEXT-METHOD) :type (or null generic-function) - :accessor std-method-generic-function) - ($initfunction ; returns - if called - the fast-function - ; (only for the purpose of ADD-METHOD) - :type function - :accessor std-method-initfunction)) + :accessor std-method-generic-function)) (:fixed-slot-locations t) (:generic-accessors nil))) @@ -196,7 +192,6 @@ (setf (std-method-signature method) signature) (setf (std-method-documentation method) documentation) (setf (std-method-generic-function method) gf) - (setf (std-method-initfunction method) initfunction) method) (defun make-instance-<standard-method> (class &rest args Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3674 retrieving revision 1.3675 diff -u -d -r1.3674 -r1.3675 --- ChangeLog 18 Oct 2004 11:00:35 -0000 1.3674 +++ ChangeLog 18 Oct 2004 11:01:47 -0000 1.3675 @@ -1,5 +1,10 @@ 2004-10-10 Bruno Haible <br...@cl...> + * clos-method1.lisp (standard-method): Remove initfunction slot. + (initialize-instance-<standard-method>): Update. + * clos-genfun4.lisp (initialize-extended-method-check): Update. + * disassem.lisp (disassemble@standard-method): Update. + Now that methods are never copied, move the initfunction invocation to the initializer. * clos-method1.lisp (initialize-instance-<standard-method>): Invoke --__--__-- Message: 3 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-genfun2.lisp,1.59,1.60 ChangeLog,1.3675,1.3676 Date: Mon, 18 Oct 2004 11:48:19 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18209/src Modified Files: clos-genfun2.lisp ChangeLog Log Message: Don't warn when adding a method to compute-effective-method or similar. Index: clos-genfun2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun2.lisp,v retrieving revision 1.59 retrieving revision 1.60 diff -u -d -r1.59 -r1.60 --- clos-genfun2.lisp 18 Oct 2004 11:00:34 -0000 1.59 +++ clos-genfun2.lisp 18 Oct 2004 11:48:14 -0000 1.60 @@ -682,20 +682,42 @@ (defvar *dynamically-modifiable-generic-function-names* ;; A list of names of functions, which ANSI CL explicitly denotes as ;; "Standard Generic Function"s, meaning that the user may add methods. - '(add-method allocate-instance class-name describe-object find-method - function-keywords initialize-instance make-instance method-qualifiers - no-applicable-method no-next-method no-primary-method print-object - reinitialize-instance remove-method shared-initialize slot-missing - change-class update-instance-for-different-class - update-instance-for-redefined-class - slot-unbound make-load-form + '(add-method allocate-instance change-class class-name (setf class-name) + compute-applicable-methods describe-object documentation + (setf documentation) find-method function-keywords initialize-instance + make-instance make-instances-obsolete make-load-form method-qualifiers + no-applicable-method no-next-method print-object reinitialize-instance + remove-method shared-initialize slot-missing slot-unbound + update-instance-for-different-class update-instance-for-redefined-class ;; Similar functions from the MOP. - validate-superclass)) + add-dependent remove-dependent map-dependents + add-direct-method remove-direct-method + specializer-direct-generic-functions specializer-direct-methods + add-direct-subclass remove-direct-subclass class-direct-subclasses + compute-applicable-methods-using-classes + compute-class-precedence-list + compute-default-initargs + compute-discriminating-function + compute-effective-method + compute-effective-slot-definition + compute-slots + direct-slot-definition-class + effective-slot-definition-class + ensure-class-using-class + ensure-generic-function-using-class + reader-method-class + slot-value-using-class (setf slot-value-using-class) + slot-boundp-using-class slot-makunbound-using-class + validate-superclass + writer-method-class + ;; Similar functions that are CLISP extensions. + (setf method-generic-function) no-primary-method)) (defvar *warn-if-gf-already-called* t) (defun need-gf-already-called-warning-p (gf) (and *warn-if-gf-already-called* (not (gf-never-called-p gf)) - (not (memq (sys::closure-name gf) - *dynamically-modifiable-generic-function-names*)))) + (not (member (sys::closure-name gf) + *dynamically-modifiable-generic-function-names* + :test #'equal)))) (defun warn-if-gf-already-called (gf) (when (need-gf-already-called-warning-p gf) (warn (TEXT "The generic function ~S is being modified, but has already been called.") Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3675 retrieving revision 1.3676 diff -u -d -r1.3675 -r1.3676 --- ChangeLog 18 Oct 2004 11:01:47 -0000 1.3675 +++ ChangeLog 18 Oct 2004 11:48:14 -0000 1.3676 @@ -1,5 +1,11 @@ 2004-10-10 Bruno Haible <br...@cl...> + * clos-genfun2.lisp (*dynamically-modifiable-generic-function-names*): + Add many MOP generic function names. + (need-gf-already-called-warning-p): Test membership with equal, not eq. + +2004-10-10 Bruno Haible <br...@cl...> + * clos-method1.lisp (standard-method): Remove initfunction slot. (initialize-instance-<standard-method>): Update. * clos-genfun4.lisp (initialize-extended-method-check): Update. --__--__-- Message: 4 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos.lisp,1.97,1.98 Date: Mon, 18 Oct 2004 11:48:51 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18529/src Modified Files: clos.lisp Log Message: Document a debugging technique. Index: clos.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos.lisp,v retrieving revision 1.97 retrieving revision 1.98 diff -u -d -r1.97 -r1.98 --- clos.lisp 29 Sep 2004 10:38:11 -0000 1.97 +++ clos.lisp 18 Oct 2004 11:48:48 -0000 1.98 @@ -253,6 +253,34 @@ ; (setf (sys::%record-ref instance 1) new-value)) +;; Debugging Techniques + +; Some generic functions, like compute-effective-method or method-specializers, +; are used to implement the behaviour of generic functions. We have a boot- +; strapping problem here. +; Since we try to call the generic function whenever possible, and the non- +; generic particular method only if absolutely necessary, the technique is to +; write generic code and break the metacircularity at selected points. +; In practice this means you get a "*** - Lisp stack overflow. RESET" message +; and have to break the endless recursion. How to detect the metacircularity +; that causes the endless recursion? +; 1. Start "./lisp.run -i init.lisp | tee log". You get "Lisp stack overflow". +; 2. Find the source form which causes the endless recursion. If you are +; unsure, add a ":echo t" to the LOAD form loading the particular form in +; init.lisp or clos.lisp and go back to step 1. +; 3. At the prompt, type (in-package "CLOS") and the problematic source form. +; 4. While it is executing, eating more and more stack, interrupt it through a +; "kill -2 <pid>" from a nearby shell window, where <pid> is the lisp.run's +; process id. (Just pressing Ctrl-C would kill the lisp.run and tee +; processes.) +; 5. Type (ext:show-stack). +; 6. Analyze the resulting log file. To find the loop in the stack trace, +; concentrate on the middle. You have to skip the first 500 or 1000 lines +; of stack trace. To get a quick overview, look at only the lines +; starting with "APPLY frame". +; 7. Think about the ideal point for breaking the loop. + + ;; Extension Protocols ; The MOP specifies the following individual protocols. --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-class3.lisp,1.55,1.56 ChangeLog,1.3676,1.3677 Date: Mon, 18 Oct 2004 11:51:32 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19004/src Modified Files: clos-class3.lisp ChangeLog Log Message: Avoid clobbering empty-ht. Index: clos-class3.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class3.lisp,v retrieving revision 1.55 retrieving revision 1.56 diff -u -d -r1.55 -r1.56 --- clos-class3.lisp 15 Oct 2004 11:32:22 -0000 1.55 +++ clos-class3.lisp 18 Oct 2004 11:51:29 -0000 1.56 @@ -1695,10 +1695,16 @@ #'(lambda (slot) (member (slot-definition-name slot) slotnames))) (compute-slots-<class>-primary c)))))) (setf (class-instance-size class) (max size (compute-instance-size class))) - (let ((ht (class-slot-location-table class))) - (dolist (slot (class-slots class)) - (setf (gethash (slot-definition-name slot) ht) - (slot-definition-location slot)))) + (when (class-slots class) + (let ((ht (class-slot-location-table class))) + (when (eq ht empty-ht) ; avoid clobbering empty-ht! + (setq ht (setf (class-slot-location-table class) + (make-hash-table + :key-type 'symbol :value-type 't + :test 'ext:stablehash-eq :warn-if-needs-rehash-after-gc t)))) + (dolist (slot (class-slots class)) + (setf (gethash (slot-definition-name slot) ht) + (slot-definition-location slot))))) (when (plusp (compute-shared-size class)) (error-of-type 'error (TEXT "(~S ~S): metaclass ~S does not support shared slots") Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3676 retrieving revision 1.3677 diff -u -d -r1.3676 -r1.3677 --- ChangeLog 18 Oct 2004 11:48:14 -0000 1.3676 +++ ChangeLog 18 Oct 2004 11:51:29 -0000 1.3677 @@ -1,3 +1,8 @@ +2004-10-14 Bruno Haible <br...@cl...> + + * clos-class3.lisp (shared-initialize-<structure-class>): Don't make + side-effects on empty-ht and on all other structure-class instances. + 2004-10-10 Bruno Haible <br...@cl...> * clos-genfun2.lisp (*dynamically-modifiable-generic-function-names*): --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src describe.lisp,1.56,1.57 ChangeLog,1.3677,1.3678 Date: Mon, 18 Oct 2004 11:52:47 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19342/src Modified Files: describe.lisp ChangeLog Log Message: Describe support for weak data types. Index: describe.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/describe.lisp,v retrieving revision 1.56 retrieving revision 1.57 diff -u -d -r1.56 -r1.57 --- describe.lisp 14 Oct 2004 11:54:34 -0000 1.56 +++ describe.lisp 18 Oct 2004 11:52:44 -0000 1.57 @@ -146,6 +146,51 @@ value) (describe value stream)) (format stream (TEXT "a GC-invisible pointer to a now defunct object."))))) + (EXT:WEAK-LIST + (let ((remaining (weak-list-list obj))) + (if remaining + (format stream (TEXT "a list of GC-invisible pointers to ~{~S~^, ~}.") + remaining) + (format stream (TEXT "a list of GC-invisible pointers, all defunct by now."))))) + (EXT:WEAK-AND-RELATION + (let ((remaining (weak-and-relation-list obj))) + (if remaining + (format stream (TEXT "a weak \"and\" relation between ~{~S~^, ~}.") + remaining) + (format stream (TEXT "a weak \"and\" relation, no longer referring to its objects."))))) + (EXT:WEAK-OR-RELATION + (let ((remaining (weak-or-relation-list obj))) + (if remaining + (format stream (TEXT "a weak \"or\" relation between ~{~S~^, ~}.") + remaining) + (format stream (TEXT "a weak \"or\" relation, all elements defunct by now."))))) + (EXT:WEAK-MAPPING + (multiple-value-bind (key value alive) (weak-mapping-pair obj) + (if alive + (format stream (TEXT "a weak association from ~S to ~S.") key value) + (format stream (TEXT "a weak association, the key value being defunct by now."))))) + (EXT:WEAK-AND-MAPPING + (multiple-value-bind (keys value alive) (weak-and-mapping-pair obj) + (if alive + (format stream (TEXT "a weak \"and\" mapping from ~:S to ~S.") keys value) + (format stream (TEXT "a weak \"and\" mapping, some key value being defunct by now."))))) + (EXT:WEAK-OR-MAPPING + (multiple-value-bind (keys value alive) (weak-or-mapping-pair obj) + (if alive + (format stream (TEXT "a weak \"or\" mapping from ~:S to ~S.") keys value) + (format stream (TEXT "a weak \"or\" mapping, all keys being defunct by now."))))) + (EXT:WEAK-ALIST + (let ((type (weak-alist-type obj)) + (remaining (weak-alist-contents obj))) + (format stream (TEXT "a weak association list, of type ~S ") type) + (ecase type + (:KEY (format stream (TEXT "(i.e. a list of EXT:WEAK-MAPPING key/value pairs)"))) + (:VALUE (format stream (TEXT "(i.e. a list of EXT:WEAK-MAPPING value/key pairs)"))) + (:EITHER (format stream (TEXT "(i.e. a list of (key . value) pairs each combined into a EXT:WEAK-AND-RELATION)"))) + (:BOTH (format stream (TEXT "(i.e. a list of (key . value) pairs each combined into a EXT:WEAK-OR-RELATION)")))) + (if remaining + (format stream (TEXT ", containing ~S.") remaining) + (format stream (TEXT ", no longer referring to any pairs."))))) (SYS::READ-LABEL (format stream (TEXT "a label used for resolving #~D# references during READ.") (logand (sys::address-of obj) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3677 retrieving revision 1.3678 diff -u -d -r1.3677 -r1.3678 --- ChangeLog 18 Oct 2004 11:51:29 -0000 1.3677 +++ ChangeLog 18 Oct 2004 11:52:44 -0000 1.3678 @@ -1,5 +1,11 @@ 2004-10-14 Bruno Haible <br...@cl...> + * describe.lisp (describe-object@t): Handle the weak-list, + weak-and-relation, weak-or-relation, weak-mapping, weak-and-mapping, + weak-or-mapping, weak-alist types. + +2004-10-14 Bruno Haible <br...@cl...> + * clos-class3.lisp (shared-initialize-<structure-class>): Don't make side-effects on empty-ht and on all other structure-class instances. --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-class2.lisp,1.43,1.44 Date: Mon, 18 Oct 2004 11:53:32 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19667/src Modified Files: clos-class2.lisp Log Message: Fix comments. Index: clos-class2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class2.lisp,v retrieving revision 1.43 retrieving revision 1.44 diff -u -d -r1.43 -r1.44 --- clos-class2.lisp 5 Aug 2004 11:15:25 -0000 1.43 +++ clos-class2.lisp 18 Oct 2004 11:53:30 -0000 1.44 @@ -22,11 +22,11 @@ (defvar <structure-object>) ; <structure-class> (defvar <generic-function>) ; <funcallable-standard-class> (defvar <standard-generic-function>) ; <funcallable-standard-class> -;(defvar <method>) ; here <structure-class> -;(defvar <standard-method>) ; here <structure-class> -(defvar <standard-reader-method>) ; here <structure-class> -(defvar <standard-writer-method>) ; here <structure-class> -;(defvar <method-combination>) ; here <structure-class> +;(defvar <method>) ; <standard-class> +;(defvar <standard-method>) ; <standard-class> +(defvar <standard-reader-method>) ; <standard-class> +(defvar <standard-writer-method>) ; <standard-class> +;(defvar <method-combination>) ; <standard-class> (defvar <array>) ; <built-in-class> (defvar <bit-vector>) ; <built-in-class> (defvar <character>) ; <built-in-class> --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-class3.lisp,1.56,1.57 ChangeLog,1.3678,1.3679 Date: Mon, 18 Oct 2004 11:55:26 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19960/src Modified Files: clos-class3.lisp ChangeLog Log Message: Double quoting bug. Index: clos-class3.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-class3.lisp,v retrieving revision 1.56 retrieving revision 1.57 diff -u -d -r1.56 -r1.57 --- clos-class3.lisp 18 Oct 2004 11:51:29 -0000 1.56 +++ clos-class3.lisp 18 Oct 2004 11:55:22 -0000 1.57 @@ -236,7 +236,7 @@ ,@(when writers `(:WRITERS ',writers)) ,@(when (eq allocation ':class) `(:ALLOCATION :CLASS)) ,@(when initargs `(:INITARGS ',(nreverse initargs))) - ,@(when initform `(:INITFORM ',initform :INITFUNCTION ,initfunction)) + ,@(when initform `(:INITFORM ,initform :INITFUNCTION ,initfunction)) ,@(when types `(:TYPE ',(first types))) ,@(when documentation `(:DOCUMENTATION ',documentation)) ,@(when user-defined-args Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3678 retrieving revision 1.3679 diff -u -d -r1.3678 -r1.3679 --- ChangeLog 18 Oct 2004 11:52:44 -0000 1.3678 +++ ChangeLog 18 Oct 2004 11:55:23 -0000 1.3679 @@ -1,3 +1,8 @@ +2004-10-16 Bruno Haible <br...@cl...> + + * clos-class3.lisp (defclass): Remove a level of quoting for the slot + initforms. + 2004-10-14 Bruno Haible <br...@cl...> * describe.lisp (describe-object@t): Handle the weak-list, --__--__-- Message: 9 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src TODO,1.24,1.25 Date: Mon, 18 Oct 2004 17:32:02 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11761/src Modified Files: TODO Log Message: Reentrancy: remove the static filestatus variable from pathname.d Index: TODO =================================================================== RCS file: /cvsroot/clisp/clisp/src/TODO,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- TODO 8 Oct 2004 10:44:26 -0000 1.24 +++ TODO 18 Oct 2004 17:31:59 -0000 1.25 @@ -42,14 +42,14 @@ [1]> (read-char) abcdef #\a -[2]> +[2]> *** - EVAL: variable BCDEF has no value Mögliche Optionen: USE-VALUE :R1 Sie dürfen einen Ersatzwertfür BDEF eingeben. STORE-VALUE :R2 Sie dürfen einen neuen Wert für BDEF eingeben. ABORT :R3 ABORT -Break 1 [3]> +Break 1 [3]> Make the *KEYBOARD-STREAM* recognize all kinds of function keys in Linux @@ -62,6 +62,9 @@ Use macroexpand-form instead. +Reentrancy: remove the static filestatus variable from pathname.d. + + Better error checking in get-setf-expansion for long defsetf --__--__-- Message: 10 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src fill-out.lisp,1.9,1.10 ChangeLog,1.3679,1.3680 Date: Mon, 18 Oct 2004 17:49:22 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16048/clisp/src Modified Files: fill-out.lisp ChangeLog Log Message: (right-margin, fill-stream-text-indent): new functions (fill-stream, fill-stream-flush-buffer): use them (fill-stream-line-position): renamed from LINE-POS Index: fill-out.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/fill-out.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- fill-out.lisp 29 Sep 2004 12:07:42 -0000 1.9 +++ fill-out.lisp 18 Oct 2004 17:49:17 -0000 1.10 @@ -10,41 +10,47 @@ (import '(fill-stream with-fill-stream) "SYS") (in-package "SYSTEM") +(declaim (inline right-margin)) +(defun right-margin () (or *print-right-margin* sys::*prin-linelength*)) + (defclass fill-stream (fundamental-character-output-stream) ((target-stream :initarg :stream :type stream) (buffer :type string :initform - (make-array (or *print-right-margin* sys::*prin-linelength*) - :element-type 'character :fill-pointer 0 - :adjustable t)) + (make-array (right-margin) :element-type 'character + :fill-pointer 0 :adjustable t)) (inside-sexp :initform nil :type boolean) ;; the indentation level variable or number: (indent-var :initarg :indent :initform 0 :type (or symbol integer)) (pending-space :initform nil :type boolean) (current-indent :initform 0 :type integer) ; current line indentation (pending-indent :initform nil :type (or null integer)))) -(defun line-pos (fill-stream) + +(defun fill-stream-line-position (fill-stream) (with-slots (target-stream buffer pending-space) fill-stream (let ((pos (sys::line-position target-stream))) (if pos (+ pos (if pending-space 1 0) (string-width buffer)) nil)))) + +(defun fill-stream-text-indent (stream) + (let ((text-indent-raw (slot-value stream 'indent-var))) + (etypecase text-indent-raw + (number text-indent-raw) + (symbol (symbol-value text-indent-raw))))) + ;; flush the buffer and print a newline (when NEWLINE-P is non-NIL) (defun fill-stream-flush-buffer (stream newline-p) (with-slots (target-stream buffer pending-indent current-indent indent-var pending-space inside-sexp) stream (flet ((newline () ; terpri - (setq current-indent - (if (symbolp indent-var) - (symbol-value indent-var) - indent-var) + (setq current-indent (fill-stream-text-indent stream) pending-indent current-indent) (terpri target-stream))) (when (plusp (length buffer)) ; something in the buffer to flush ;; fill: if the buffer does not fit on the line, TERPRI - (let ((pos (line-pos stream))) - (when (and pos - (<= (or *print-right-margin* sys::*prin-linelength*) pos)) + (let ((pos (fill-stream-line-position stream))) + (when (and pos (<= (right-margin) pos)) ; does not fit on this line (unless (find #\newline buffer) ; can happen only inside sexp (newline)) (when inside-sexp ; just finished an S-expression @@ -59,6 +65,7 @@ (write-char-sequence buffer target-stream) (setf (fill-pointer buffer) 0)) (when newline-p (newline))))) + (progn (defmethod stream-write-char ((stream fill-stream) ch) (with-slots #1=(buffer pending-space inside-sexp) stream @@ -78,11 +85,12 @@ ;; Same body as in stream-write-char. (count-if (lambda (ch) #2#) sequence :start start :end end)) sequence)) + (defmethod stream-line-column ((stream fill-stream)) - (let ((pos (line-pos stream))) + (let ((pos (fill-stream-line-position stream))) (if pos (max (- pos (slot-value stream 'current-indent)) 0) nil))) (defmethod stream-start-line-p ((stream fill-stream)) - (let ((pos (line-pos stream))) + (let ((pos (fill-stream-line-position stream))) (if pos (<= pos (slot-value stream 'current-indent)) nil))) (defmethod stream-finish-output ((stream fill-stream)) (fill-stream-flush-buffer stream nil) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3679 retrieving revision 1.3680 diff -u -d -r1.3679 -r1.3680 --- ChangeLog 18 Oct 2004 11:55:23 -0000 1.3679 +++ ChangeLog 18 Oct 2004 17:49:17 -0000 1.3680 @@ -1,3 +1,9 @@ +2004-10-18 Sam Steingold <sd...@gn...> + + * fill-out.lisp (right-margin, fill-stream-text-indent): new functions + (fill-stream, fill-stream-flush-buffer): use them + (fill-stream-line-position): renamed from LINE-POS + 2004-10-16 Bruno Haible <br...@cl...> * clos-class3.lisp (defclass): Remove a level of quoting for the slot --__--__-- Message: 11 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src clos-print.lisp,1.13,1.14 ChangeLog,1.3680,1.3681 Date: Mon, 18 Oct 2004 17:50:39 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16372/src Modified Files: clos-print.lisp ChangeLog Log Message: (compute-effective-method): avoid a compiler warning Index: clos-print.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-print.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- clos-print.lisp 12 Oct 2004 11:20:16 -0000 1.13 +++ clos-print.lisp 18 Oct 2004 17:50:36 -0000 1.14 @@ -44,7 +44,9 @@ (let ((*print-object-method-warning* nil)) (warn (TEXT "~S: invalid method ~S. ANSI CL requires that every ~S method returns the object as value. Expected ~S, but it returned ~S.") 'print-object method 'print-object object result)))) -(defmethod compute-effective-method ((gf (eql #'print-object)) method-combination methods) +(defmethod compute-effective-method ((gf (eql #'print-object)) + method-combination methods) + (declare (ignore method-combination)) (multiple-value-bind (form options) (call-next-method) (let ((object-var (gensym)) (result-var (gensym))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3680 retrieving revision 1.3681 diff -u -d -r1.3680 -r1.3681 --- ChangeLog 18 Oct 2004 17:49:17 -0000 1.3680 +++ ChangeLog 18 Oct 2004 17:50:36 -0000 1.3681 @@ -1,5 +1,9 @@ 2004-10-18 Sam Steingold <sd...@gn...> + * clos-print.lisp (compute-effective-method): avoid a compiler warning + +2004-10-18 Sam Steingold <sd...@gn...> + * fill-out.lisp (right-margin, fill-stream-text-indent): new functions (fill-stream, fill-stream-flush-buffer): use them (fill-stream-line-position): renamed from LINE-POS --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |