From 7a252d11f301cb52381b1ed918b820ff631b7b69 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 21 Aug 2007 15:53:39 +0000 Subject: (byte-compile-interactive-only-functions): Add previous-line and next-line. --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 286725f99c1..45c8422e64f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -385,7 +385,7 @@ Elements of the list may be: (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp - insert-file insert-buffer insert-file-literally) + insert-file insert-buffer insert-file-literally previous-line next-line) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-var nil -- cgit v1.2.3 From 5d3440f4b66db7730f74633de13b0c66f1b4cde2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 21 Aug 2007 19:09:25 +0000 Subject: (backquote-delay-process): Fix last change. --- lisp/ChangeLog | 2 ++ lisp/emacs-lisp/backquote.el | 5 ++--- 2 files changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8e39c452f2d..7f3982626fd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2007-08-21 Stefan Monnier + * emacs-lisp/backquote.el (backquote-delay-process): Fix last change. + * progmodes/ada-mode.el: Fix up comment style in header. (ada-check-emacs-version): Remove. (ada-mode): Set parse-sexp-* even if they don't exist: can't hurt. diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 6daaf001433..8b966f51626 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -121,9 +121,8 @@ Vectors work just like lists. Nested backquotes are permitted." (defun backquote-delay-process (s level) "Process a (un|back|splice)quote inside a backquote. This simply recurses through the body." - (let ((exp (backquote-listify (list (backquote-process (nth 1 s) level) - (cons 0 (list 'quote (car s)))) - '(0)))) + (let ((exp (backquote-listify (list (cons 0 (list 'quote (car s)))) + (backquote-process (cdr s) level)))) (if (eq (car-safe exp) 'quote) (cons 0 (list 'quote s)) (cons 1 exp)))) -- cgit v1.2.3 From 008e2c2a698f9ff46263ed22ecc5fbdfd93b68f3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 22 Aug 2007 15:51:13 +0000 Subject: (byte-compile-log-file, byte-recompile-directory, byte-compile-file) (byte-compile-from-buffer): Use with-current-buffer. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/bytecomp.el | 22 +++++++++------------- 2 files changed, 13 insertions(+), 13 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bd7c4704c77..cd33d38a498 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2007-08-22 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-log-file) + (byte-recompile-directory, byte-compile-file) + (byte-compile-from-buffer): Use with-current-buffer. + * simple.el (text-invisible-p): Rename from line-move-invisible-p. (line-move-invisible-p): Keep as an obsolete alias, just to be safe. (line-move-1, line-move-finish, line-move-to-column) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b3b9ca81ea4..12fab768db5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1008,8 +1008,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (defun byte-compile-log-file () (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) (not noninteractive) - (save-excursion - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (goto-char (point-max)) (let* ((inhibit-read-only t) (dir (and byte-compile-current-file @@ -1545,8 +1544,7 @@ recompile every `.el' file that already has a `.elc' file." nil (save-some-buffers) (force-mode-line-update)) - (save-current-buffer - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (setq default-directory (expand-file-name directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode) @@ -1648,7 +1646,7 @@ The value is non-nil if there were no errors, nil if errors." (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) + (with-current-buffer b (save-buffer))))) ;; Force logging of the file name for each file compiled. (setq byte-compile-last-logged-file nil) @@ -1658,9 +1656,8 @@ The value is non-nil if there were no errors, nil if errors." byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) - (save-excursion - (setq input-buffer (get-buffer-create " *Compiler Input*")) - (set-buffer input-buffer) + (with-current-buffer + (setq input-buffer (get-buffer-create " *Compiler Input*")) (erase-buffer) (setq buffer-file-coding-system nil) ;; Always compile an Emacs Lisp file as multibyte @@ -1830,9 +1827,8 @@ With argument, insert value in current buffer after the form." ;; byte-compile-warnings)) ) (byte-compile-close-variables - (save-excursion - (setq outbuffer - (set-buffer (get-buffer-create " *Compiler Output*"))) + (with-current-buffer + (setq outbuffer (get-buffer-create " *Compiler Output*")) (set-buffer-multibyte t) (erase-buffer) ;; (emacs-lisp-mode) @@ -1846,8 +1842,7 @@ With argument, insert value in current buffer after the form." (setq overwrite-mode 'overwrite-mode-binary)) (displaying-byte-compile-warnings (and filename (byte-compile-insert-header filename inbuffer outbuffer)) - (save-excursion - (set-buffer inbuffer) + (with-current-buffer inbuffer (goto-char 1) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been @@ -2036,6 +2031,7 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) + ;; FIXME: What's up with those set-buffers&prog1 thingy? --Stef (set-buffer (prog1 (current-buffer) (set-buffer outbuffer) -- cgit v1.2.3 From ff1104509225439f10da8e3e187fcfe5ff78bdeb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 22 Aug 2007 16:08:42 +0000 Subject: (byte-compile-from-buffer): Display a big fat warning for old style backquotes. --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/bytecomp.el | 8 +++++++- lispref/macros.texi | 2 +- 3 files changed, 11 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cd33d38a498..593a390b91a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2007-08-22 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Display a big fat + warning if the file uses old style backquotes. + * emacs-lisp/bytecomp.el (byte-compile-log-file) (byte-recompile-directory, byte-compile-file) (byte-compile-from-buffer): Use with-current-buffer. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 12fab768db5..5a7f96fb988 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1821,6 +1821,7 @@ With argument, insert value in current buffer after the form." ;; new in Emacs 22.1. (read-with-symbol-positions inbuffer) (read-symbol-positions-list nil) + (old-style-backquotes nil) ;; #### This is bound in b-c-close-variables. ;; (byte-compile-warnings (if (eq byte-compile-warnings t) ;; byte-compile-warning-types @@ -1865,7 +1866,12 @@ With argument, insert value in current buffer after the form." ;; Make warnings about unresolved functions ;; give the end of the file as their position. (setq byte-compile-last-position (point-max)) - (byte-compile-warn-about-unresolved-functions)) + (byte-compile-warn-about-unresolved-functions) + ;; Warn about the use of old-style backquotes. + (when old-style-backquotes + (byte-compile-warn "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual."))) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. (and filename (byte-compile-fix-header filename inbuffer outbuffer)))) diff --git a/lispref/macros.texi b/lispref/macros.texi index 6dea53ac983..b62c8b99d74 100644 --- a/lispref/macros.texi +++ b/lispref/macros.texi @@ -365,7 +365,7 @@ whitespace between the @samp{`}, @samp{,} or @samp{,@@} and the following expression. This syntax is still accepted, for compatibility with old Emacs -versions, but we recommend not using it in new programs. +versions, but support for it will soon disappear. @node Problems with Macros @section Common Problems Using Macros -- cgit v1.2.3 From 5ebfbcdc3f422edb3a6dc2dc347df276b134661b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 15:11:31 +0000 Subject: (byte-optimize-featurep): Also handle `sxemacs'. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/byte-opt.el | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b8a0e34cb2..f6c8615dd0f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2007-08-23 Stefan Monnier + + * emacs-lisp/byte-opt.el (byte-optimize-featurep): Also handle `sxemacs'. + 2007-08-22 Chong Yidong * image-mode.el (image-minor-mode): Use image-mode-text-map. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 82a5cf0a75a..6f653c8fc6e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1135,9 +1135,9 @@ (put 'featurep 'byte-optimizer 'byte-optimize-featurep) (defun byte-optimize-featurep (form) - ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can - ;; safely optimize away this test. - (if (equal '((quote xemacs)) (cdr-safe form)) + ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we + ;; can safely optimize away this test. + (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs))) nil form)) -- cgit v1.2.3 From 36e65f7059d02914f834cf925b98e5ce4b251af4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 18:19:56 +0000 Subject: (byte-compile-from-buffer): Check old-style backquotes after each `read' rather than once per buffer to get more precise location info. --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/bytecomp.el | 16 ++++++++-------- 2 files changed, 11 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 560b47f1344..3e3e133bbe0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2007-08-23 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Check old-style + backquotes after each `read' rather than once per buffer. + * dframe.el: Remove spurious * in custom docstrings. (dframe-xemacsp): Remove, use (featurep 'xemacs) instead. (dframe-xemacs20p): Remove, inline at the sole use point. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5a7f96fb988..932d94fb368 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1821,7 +1821,6 @@ With argument, insert value in current buffer after the form." ;; new in Emacs 22.1. (read-with-symbol-positions inbuffer) (read-symbol-positions-list nil) - (old-style-backquotes nil) ;; #### This is bound in b-c-close-variables. ;; (byte-compile-warnings (if (eq byte-compile-warnings t) ;; byte-compile-warning-types @@ -1859,19 +1858,20 @@ With argument, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let ((form (read inbuffer))) + (let* ((old-style-backquotes nil) + (form (read inbuffer))) + ;; Warn about the use of old-style backquotes. + (when old-style-backquotes + (byte-compile-warn "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual.")) (byte-compile-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) ;; Make warnings about unresolved functions ;; give the end of the file as their position. (setq byte-compile-last-position (point-max)) - (byte-compile-warn-about-unresolved-functions) - ;; Warn about the use of old-style backquotes. - (when old-style-backquotes - (byte-compile-warn "!! The file uses old-style backquotes !! -This functionality has been obsolete for more than 10 years already -and will be removed soon. See (elisp)Backquote in the manual."))) + (byte-compile-warn-about-unresolved-functions)) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. (and filename (byte-compile-fix-header filename inbuffer outbuffer)))) -- cgit v1.2.3 From 2fa9dc2f3a2ac7a023d570f7756cf05a22f80b62 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 18:38:33 +0000 Subject: (edebug-list-form, edebug-match-symbol, \,) (\,@): Backslash the , and ,@ which are not new-style unquotes. --- lisp/emacs-lisp/edebug.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a39975c993e..e975a0f0bea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1507,7 +1507,7 @@ expressions; a `progn' form will be returned enclosing these forms." head (edebug-move-cursor cursor)))))) ((consp head) - (if (eq (car head) ',) + (if (eq (car head) '\,) ;; The head of a form should normally be a symbol or a lambda ;; expression but it can also be an unquote form to be filled ;; before evaluation. We evaluate the arguments anyway, on the @@ -1664,7 +1664,7 @@ expressions; a `progn' form will be returned enclosing these forms." ((fboundp symbol) ; is it a predicate? (let ((sexp (edebug-top-element-required cursor "Expected" symbol))) ;; Special case for edebug-`. - (if (and (listp sexp) (eq (car sexp) ',)) + (if (and (listp sexp) (eq (car sexp) '\,)) (edebug-match cursor '(("," def-form))) (if (not (funcall symbol sexp)) (edebug-no-match cursor symbol "failed")) @@ -2102,8 +2102,8 @@ expressions; a `progn' form will be returned enclosing these forms." (def-edebug-spec edebug-\` (def-form)) ;; Assume immediate quote in unquotes mean backquote at next higher level. -(def-edebug-spec , (&or ("quote" edebug-\`) def-form)) -(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped. +(def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) +(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. &or ("quote" edebug-\`) def-form)) ;; New byte compiler. -- cgit v1.2.3 From 727fb8cc41be87934552338dda6afa23aecb1bc0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 18:39:20 +0000 Subject: (backquote-unquote-symbol, backquote-splice-symbol): Backslash the , and ,@ which are not new-style unquotes. --- lisp/emacs-lisp/backquote.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 8b966f51626..a2a929d9601 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -85,10 +85,10 @@ For example (backquote-list* 'a 'b 'c) => (a b . c)" (defconst backquote-backquote-symbol '\` "Symbol used to represent a backquote or nested backquote.") -(defconst backquote-unquote-symbol ', +(defconst backquote-unquote-symbol '\, "Symbol used to represent an unquote inside a backquote.") -(defconst backquote-splice-symbol ',@ +(defconst backquote-splice-symbol '\,@ "Symbol used to represent a splice inside a backquote.") ;;;###autoload -- cgit v1.2.3 From 40fafc21621fd7f5e7164bee1813a9819cab8236 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 19:56:16 +0000 Subject: (byte-optimize-if): Move `progn' out of the test so as to optimise cases where the `progn's result is constant. --- lisp/ChangeLog | 9 +++++++-- lisp/emacs-lisp/byte-opt.el | 15 ++++++++++++--- 2 files changed, 19 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 947682cdc17..dadc3e0f78c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,12 @@ +2007-08-23 Stefan Monnier + + * emacs-lisp/byte-opt.el (byte-optimize-if): Move `progn' out of the test + so as to optimise cases where the `progn's result is constant. + 2007-08-23 Thien-Thi Nguyen - * locate.el (locate-get-file-positions): Use - line-beginning-position and line-end-position. + * locate.el (locate-get-file-positions): + Use line-beginning-position and line-end-position. 2007-08-23 John Wiegley diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 82a5cf0a75a..b4eaf4ff5eb 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -31,7 +31,7 @@ ;; "No matter how hard you try, you can't make a racehorse out of a pig. ;; You can, however, make a faster pig." ;; -;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code +;; Or, to put it another way, the Emacs byte compiler is a VW Bug. This code ;; makes it be a VW Bug with fuel injection and a turbocharger... You're ;; still not going to make it go faster than 70 mph, but it might be easier ;; to get it there. @@ -1014,12 +1014,21 @@ form)) (defun byte-optimize-if (form) + ;; (if (progn ) ) ==> (progn (if )) ;; (if ) ==> ;; (if ) ==> (progn ) ;; (if nil ) ==> (if (not ) (progn )) ;; (if nil) ==> (if ) (let ((clause (nth 1 form))) - (cond ((byte-compile-trueconstp clause) + (cond ((eq (car clause) 'progn) + (if (null (cddr clause)) + ;; A trivial `progn'. + (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) + (nconc (butlast clause) + (list + (byte-optimize-if + `(if ,(car (last clause)) ,@(nthcdr 2 form))))))) + ((byte-compile-trueconstp clause) (nth 2 form)) ((null clause) (if (nthcdr 4 form) @@ -1326,7 +1335,7 @@ ;; This list contains numbers, which are pc values, ;; before each instruction. (defun byte-decompile-bytecode (bytes constvec) - "Turns BYTECODE into lapcode, referring to CONSTVEC." + "Turn BYTECODE into lapcode, referring to CONSTVEC." (let ((byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0)) -- cgit v1.2.3 From 9ec5dfe64b819bec13c8eb5691d2a57bc6c9d7ec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 23 Aug 2007 19:58:31 +0000 Subject: (byte-compile-output-docform, byte-compile-output-as-comment): Use with-current-buffer rather than a weird set-buffer&prog1 combination. --- lisp/ChangeLog | 4 + lisp/emacs-lisp/bytecomp.el | 220 ++++++++++++++++++++++---------------------- 2 files changed, 112 insertions(+), 112 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dadc3e0f78c..4105cdf3b37 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2007-08-23 Stefan Monnier + * emacs-lisp/bytecomp.el (byte-compile-output-docform) + (byte-compile-output-as-comment): Use with-current-buffer rather than + a weird set-buffer&prog1 combination. + * emacs-lisp/byte-opt.el (byte-optimize-if): Move `progn' out of the test so as to optimise cases where the `progn's result is constant. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 45c8422e64f..39ff0d8668e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2037,85 +2037,83 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (set-buffer - (prog1 (current-buffer) - (set-buffer outbuffer) - (let (position) - - ;; Insert the doc string, and make it a comment with #@LENGTH. - (and (>= (nth 1 info) 0) - dynamic-docstrings - (not byte-compile-compatibility) - (progn - ;; Make the doc string start at beginning of line - ;; for make-docfile's sake. - (insert "\n") - (setq position - (byte-compile-output-as-comment - (nth (nth 1 info) form) nil)) - (setq position (- (position-bytes position) (point-min) -1)) - ;; If the doc string starts with * (a user variable), - ;; negate POSITION. - (if (and (stringp (nth (nth 1 info) form)) - (> (length (nth (nth 1 info) form)) 0) - (eq (aref (nth (nth 1 info) form) 0) ?*)) - (setq position (- position))))) - - (if preface - (progn - (insert preface) - (prin1 name outbuffer))) - (insert (car info)) - (let ((print-escape-newlines t) - (print-quoted t) - ;; For compatibility with code before print-circle, - ;; use a cons cell to say that we want - ;; print-gensym-alist not to be cleared - ;; between calls to print functions. - (print-gensym '(t)) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle)) - print-gensym-alist ; was used before print-circle existed. - (print-continuous-numbering t) - print-number-table - (index 0)) - (prin1 (car form) outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (dotimes (i (length print-number-table)) - (if (aref print-number-table i) - (setq non-nil t))) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (let ((position - (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (setq position (- (position-bytes position) (point-min) -1)) - (princ (format "(#$ . %d) nil" position) outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((= index (nth 1 info)) - (if position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - position) - outbuffer) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) outbuffer))) - (insert "\\\n") - (goto-char (point-max))))) - (t - (prin1 (car form) outbuffer))))) - (insert (nth 2 info)))))) + (with-current-buffer outbuffer + (let (position) + + ;; Insert the doc string, and make it a comment with #@LENGTH. + (and (>= (nth 1 info) 0) + dynamic-docstrings + (not byte-compile-compatibility) + (progn + ;; Make the doc string start at beginning of line + ;; for make-docfile's sake. + (insert "\n") + (setq position + (byte-compile-output-as-comment + (nth (nth 1 info) form) nil)) + (setq position (- (position-bytes position) (point-min) -1)) + ;; If the doc string starts with * (a user variable), + ;; negate POSITION. + (if (and (stringp (nth (nth 1 info) form)) + (> (length (nth (nth 1 info) form)) 0) + (eq (aref (nth (nth 1 info) form) 0) ?*)) + (setq position (- position))))) + + (if preface + (progn + (insert preface) + (prin1 name outbuffer))) + (insert (car info)) + (let ((print-escape-newlines t) + (print-quoted t) + ;; For compatibility with code before print-circle, + ;; use a cons cell to say that we want + ;; print-gensym-alist not to be cleared + ;; between calls to print functions. + (print-gensym '(t)) + (print-circle ; handle circular data structures + (not byte-compile-disable-print-circle)) + print-gensym-alist ; was used before print-circle existed. + (print-continuous-numbering t) + print-number-table + (index 0)) + (prin1 (car form) outbuffer) + (while (setq form (cdr form)) + (setq index (1+ index)) + (insert " ") + (cond ((and (numberp specindex) (= index specindex) + ;; Don't handle the definition dynamically + ;; if it refers (or might refer) + ;; to objects already output + ;; (for instance, gensyms in the arg list). + (let (non-nil) + (dotimes (i (length print-number-table)) + (if (aref print-number-table i) + (setq non-nil t))) + (not non-nil))) + ;; Output the byte code and constants specially + ;; for lazy dynamic loading. + (let ((position + (byte-compile-output-as-comment + (cons (car form) (nth 1 form)) + t))) + (setq position (- (position-bytes position) (point-min) -1)) + (princ (format "(#$ . %d) nil" position) outbuffer) + (setq form (cdr form)) + (setq index (1+ index)))) + ((= index (nth 1 info)) + (if position + (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") + position) + outbuffer) + (let ((print-escape-newlines nil)) + (goto-char (prog1 (1+ (point)) + (prin1 (car form) outbuffer))) + (insert "\\\n") + (goto-char (point-max))))) + (t + (prin1 (car form) outbuffer))))) + (insert (nth 2 info))))) nil) (defun byte-compile-keep-pending (form &optional handler) @@ -2401,39 +2399,37 @@ list that represents a doc string reference. ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) - (set-buffer - (prog1 (current-buffer) - (set-buffer outbuffer) - - ;; Insert EXP, and make it a comment with #@LENGTH. - (insert " ") - (if quoted - (prin1 exp outbuffer) - (princ exp outbuffer)) - (goto-char position) - ;; Quote certain special characters as needed. - ;; get_doc_string in doc.c does the unquoting. - (while (search-forward "\^A" nil t) - (replace-match "\^A\^A" t t)) - (goto-char position) - (while (search-forward "\000" nil t) - (replace-match "\^A0" t t)) - (goto-char position) - (while (search-forward "\037" nil t) - (replace-match "\^A_" t t)) - (goto-char (point-max)) - (insert "\037") - (goto-char position) - (insert "#@" (format "%d" (- (position-bytes (point-max)) - (position-bytes position)))) - - ;; Save the file position of the object. - ;; Note we should add 1 to skip the space - ;; that we inserted before the actual doc string, - ;; and subtract 1 to convert from an 1-origin Emacs position - ;; to a file position; they cancel. - (setq position (point)) - (goto-char (point-max)))) + (with-current-buffer outbuffer + + ;; Insert EXP, and make it a comment with #@LENGTH. + (insert " ") + (if quoted + (prin1 exp outbuffer) + (princ exp outbuffer)) + (goto-char position) + ;; Quote certain special characters as needed. + ;; get_doc_string in doc.c does the unquoting. + (while (search-forward "\^A" nil t) + (replace-match "\^A\^A" t t)) + (goto-char position) + (while (search-forward "\000" nil t) + (replace-match "\^A0" t t)) + (goto-char position) + (while (search-forward "\037" nil t) + (replace-match "\^A_" t t)) + (goto-char (point-max)) + (insert "\037") + (goto-char position) + (insert "#@" (format "%d" (- (position-bytes (point-max)) + (position-bytes position)))) + + ;; Save the file position of the object. + ;; Note we should add 1 to skip the space + ;; that we inserted before the actual doc string, + ;; and subtract 1 to convert from an 1-origin Emacs position + ;; to a file position; they cancel. + (setq position (point)) + (goto-char (point-max))) position)) -- cgit v1.2.3 From 43fcc18a256823e093a3aea795451f71e795c553 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 24 Aug 2007 02:30:59 +0000 Subject: Nikolaj Schumacher (tiny change) (eldoc-highlight-function-argument): New face. (eldoc-highlight-function-argument): Use it. --- lisp/emacs-lisp/eldoc.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 8b2538d299c..1d2441f884a 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -101,6 +101,11 @@ truncated to make more of the arglist or documentation string visible." enable argument list to fit on one line" truncate-sym-name-if-fit)) :group 'eldoc) +(defface eldoc-highlight-function-argument + '((t (:inherit bold))) + "Face used for the argument at point in a function's argument list." + :group 'eldoc) + ;;; No user options below here. (defvar eldoc-message-commands-table-size 31 @@ -303,7 +308,7 @@ highlights argument number INDEX. " In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (let ((start nil) (end 0) - (argument-face 'bold)) + (argument-face 'eldoc-highlight-function-argument)) ;; Find the current argument in the argument string. We need to ;; handle `&rest' and informal `...' properly. ;; -- cgit v1.2.3 From 5e4599b863c0ef54d4a170f6e2c0e70f21919f30 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 24 Aug 2007 02:43:19 +0000 Subject: Regenerate. --- lisp/emacs-lisp/cl-loaddefs.el | 118 ++++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 59 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 7d94faa4456..a46fead6eb5 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -283,53 +283,53 @@ Not documented ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* ;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" -;;;;;; "cl-macs.el" "d9759da97810bc01423e77442b459468") +;;;;;; "cl-macs.el" "d1c9f68f599fbec644a06dd5cf520fb5") ;;; Generated autoloads from cl-macs.el -(autoload (quote cl-compile-time-init) "cl-macs" "\ +(autoload 'cl-compile-time-init "cl-macs" "\ Not documented \(fn)" nil nil) -(autoload (quote gensym) "cl-macs" "\ +(autoload 'gensym "cl-macs" "\ Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\". \(fn &optional PREFIX)" nil nil) -(autoload (quote gentemp) "cl-macs" "\ +(autoload 'gentemp "cl-macs" "\ Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\". \(fn &optional PREFIX)" nil nil) -(autoload (quote defun*) "cl-macs" "\ +(autoload 'defun* "cl-macs" "\ Define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) -(autoload (quote defmacro*) "cl-macs" "\ +(autoload 'defmacro* "cl-macs" "\ Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) -(autoload (quote function*) "cl-macs" "\ +(autoload 'function* "cl-macs" "\ Introduce a function. Like normal `function', except that if argument is a lambda form, its argument list allows full Common Lisp conventions. \(fn FUNC)" nil (quote macro)) -(autoload (quote destructuring-bind) "cl-macs" "\ +(autoload 'destructuring-bind "cl-macs" "\ Not documented \(fn ARGS EXPR &rest BODY)" nil (quote macro)) -(autoload (quote eval-when) "cl-macs" "\ +(autoload 'eval-when "cl-macs" "\ Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. @@ -337,13 +337,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" nil (quote macro)) -(autoload (quote load-time-value) "cl-macs" "\ +(autoload 'load-time-value "cl-macs" "\ Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant. \(fn FORM &optional READ-ONLY)" nil (quote macro)) -(autoload (quote case) "cl-macs" "\ +(autoload 'case "cl-macs" "\ Eval EXPR and choose among clauses on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. @@ -354,13 +354,13 @@ Key values are compared by `eql'. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) -(autoload (quote ecase) "cl-macs" "\ +(autoload 'ecase "cl-macs" "\ Like `case', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) -(autoload (quote typecase) "cl-macs" "\ +(autoload 'typecase "cl-macs" "\ Evals EXPR, chooses among clauses on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, @@ -369,13 +369,13 @@ final clause, and matches if no other keys match. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) -(autoload (quote etypecase) "cl-macs" "\ +(autoload 'etypecase "cl-macs" "\ Like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) -(autoload (quote block) "cl-macs" "\ +(autoload 'block "cl-macs" "\ Define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' @@ -387,13 +387,13 @@ called from BODY. \(fn NAME &rest BODY)" nil (quote macro)) -(autoload (quote return) "cl-macs" "\ +(autoload 'return "cl-macs" "\ Return from the block named nil. This is equivalent to `(return-from nil RESULT)'. \(fn &optional RESULT)" nil (quote macro)) -(autoload (quote return-from) "cl-macs" "\ +(autoload 'return-from "cl-macs" "\ Return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). @@ -402,7 +402,7 @@ This is compatible with Common Lisp, but note that `defun' and \(fn NAME &optional RESULT)" nil (quote macro)) -(autoload (quote loop) "cl-macs" "\ +(autoload 'loop "cl-macs" "\ The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, @@ -418,24 +418,24 @@ Valid clauses are: \(fn CLAUSE...)" nil (quote macro)) -(autoload (quote do) "cl-macs" "\ +(autoload 'do "cl-macs" "\ The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) -(autoload (quote do*) "cl-macs" "\ +(autoload 'do* "cl-macs" "\ The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) -(autoload (quote dolist) "cl-macs" "\ +(autoload 'dolist "cl-macs" "\ Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. \(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro)) -(autoload (quote dotimes) "cl-macs" "\ +(autoload 'dotimes "cl-macs" "\ Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default @@ -443,26 +443,26 @@ nil. \(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro)) -(autoload (quote do-symbols) "cl-macs" "\ +(autoload 'do-symbols "cl-macs" "\ Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY. \(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro)) -(autoload (quote do-all-symbols) "cl-macs" "\ +(autoload 'do-all-symbols "cl-macs" "\ Not documented \(fn SPEC &rest BODY)" nil (quote macro)) -(autoload (quote psetq) "cl-macs" "\ +(autoload 'psetq "cl-macs" "\ Set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values. \(fn SYM VAL SYM VAL ...)" nil (quote macro)) -(autoload (quote progv) "cl-macs" "\ +(autoload 'progv "cl-macs" "\ Bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each symbol in the first list is bound to the corresponding value in the @@ -472,7 +472,7 @@ a `let' form, except that the list of symbols can be computed at run-time. \(fn SYMBOLS VALUES &rest BODY)" nil (quote macro)) -(autoload (quote flet) "cl-macs" "\ +(autoload 'flet "cl-macs" "\ Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified @@ -481,41 +481,41 @@ go back to their previous definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote labels) "cl-macs" "\ +(autoload 'labels "cl-macs" "\ Make temporary function bindings. This is like `flet', except the bindings are lexical instead of dynamic. Unlike `flet', this macro is fully compliant with the Common Lisp standard. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote macrolet) "cl-macs" "\ +(autoload 'macrolet "cl-macs" "\ Make temporary macro definitions. This is like `flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote symbol-macrolet) "cl-macs" "\ +(autoload 'symbol-macrolet "cl-macs" "\ Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro)) -(autoload (quote lexical-let) "cl-macs" "\ +(autoload 'lexical-let "cl-macs" "\ Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. \(fn VARLIST BODY)" nil (quote macro)) -(autoload (quote lexical-let*) "cl-macs" "\ +(autoload 'lexical-let* "cl-macs" "\ Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. \(fn VARLIST BODY)" nil (quote macro)) -(autoload (quote multiple-value-bind) "cl-macs" "\ +(autoload 'multiple-value-bind "cl-macs" "\ Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This @@ -525,7 +525,7 @@ a synonym for (list A B C). \(fn (SYM...) FORM BODY)" nil (quote macro)) -(autoload (quote multiple-value-setq) "cl-macs" "\ +(autoload 'multiple-value-setq "cl-macs" "\ Collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp @@ -534,22 +534,22 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn (SYM...) FORM)" nil (quote macro)) -(autoload (quote locally) "cl-macs" "\ +(autoload 'locally "cl-macs" "\ Not documented \(fn &rest BODY)" nil (quote macro)) -(autoload (quote the) "cl-macs" "\ +(autoload 'the "cl-macs" "\ Not documented \(fn TYPE FORM)" nil (quote macro)) -(autoload (quote declare) "cl-macs" "\ +(autoload 'declare "cl-macs" "\ Not documented \(fn &rest SPECS)" nil (quote macro)) -(autoload (quote define-setf-method) "cl-macs" "\ +(autoload 'define-setf-method "cl-macs" "\ Define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were @@ -560,7 +560,7 @@ form. See `defsetf' for a simpler way to define most setf-methods. \(fn NAME ARGLIST BODY...)" nil (quote macro)) -(autoload (quote defsetf) "cl-macs" "\ +(autoload 'defsetf "cl-macs" "\ Define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of @@ -581,14 +581,14 @@ Example: \(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro)) -(autoload (quote get-setf-method) "cl-macs" "\ +(autoload 'get-setf-method "cl-macs" "\ Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'. \(fn PLACE &optional ENV)" nil nil) -(autoload (quote setf) "cl-macs" "\ +(autoload 'setf "cl-macs" "\ Set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. @@ -597,40 +597,40 @@ The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) -(autoload (quote psetf) "cl-macs" "\ +(autoload 'psetf "cl-macs" "\ Set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values. \(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) -(autoload (quote cl-do-pop) "cl-macs" "\ +(autoload 'cl-do-pop "cl-macs" "\ Not documented \(fn PLACE)" nil nil) -(autoload (quote remf) "cl-macs" "\ +(autoload 'remf "cl-macs" "\ Remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise. \(fn PLACE TAG)" nil (quote macro)) -(autoload (quote shiftf) "cl-macs" "\ +(autoload 'shiftf "cl-macs" "\ Shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE... VAL)" nil (quote macro)) -(autoload (quote rotatef) "cl-macs" "\ +(autoload 'rotatef "cl-macs" "\ Rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE...)" nil (quote macro)) -(autoload (quote letf) "cl-macs" "\ +(autoload 'letf "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding @@ -642,7 +642,7 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) -(autoload (quote letf*) "cl-macs" "\ +(autoload 'letf* "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding @@ -654,27 +654,27 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) -(autoload (quote callf) "cl-macs" "\ +(autoload 'callf "cl-macs" "\ Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn FUNC PLACE ARGS...)" nil (quote macro)) -(autoload (quote callf2) "cl-macs" "\ +(autoload 'callf2 "cl-macs" "\ Set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. \(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro)) -(autoload (quote define-modify-macro) "cl-macs" "\ +(autoload 'define-modify-macro "cl-macs" "\ Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +) \(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro)) -(autoload (quote defstruct) "cl-macs" "\ +(autoload 'defstruct "cl-macs" "\ Define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' @@ -682,24 +682,24 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. \(fn (NAME OPTIONS...) (SLOT SLOT-OPTS...)...)" nil (quote macro)) -(autoload (quote cl-struct-setf-expander) "cl-macs" "\ +(autoload 'cl-struct-setf-expander "cl-macs" "\ Not documented \(fn X NAME ACCESSOR PRED-FORM POS)" nil nil) -(autoload (quote typep) "cl-macs" "\ +(autoload 'typep "cl-macs" "\ Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier. \(fn OBJECT TYPE)" nil nil) -(autoload (quote check-type) "cl-macs" "\ +(autoload 'check-type "cl-macs" "\ Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type. \(fn FORM TYPE &optional STRING)" nil (quote macro)) -(autoload (quote assert) "cl-macs" "\ +(autoload 'assert "cl-macs" "\ Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. @@ -708,13 +708,13 @@ omitted, a default message listing FORM itself is used. \(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro)) -(autoload (quote ignore-errors) "cl-macs" "\ +(autoload 'ignore-errors "cl-macs" "\ Execute BODY; if an error occurs, return nil. Otherwise, return result of last form in BODY. \(fn &rest BODY)" nil (quote macro)) -(autoload (quote define-compiler-macro) "cl-macs" "\ +(autoload 'define-compiler-macro "cl-macs" "\ Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used @@ -728,7 +728,7 @@ and then returning foo. \(fn FUNC ARGS &rest BODY)" nil (quote macro)) -(autoload (quote compiler-macroexpand) "cl-macs" "\ +(autoload 'compiler-macroexpand "cl-macs" "\ Not documented \(fn FORM)" nil nil) -- cgit v1.2.3 From 9d693d807fbd77761cf1c35de1bcbcfc91d690e4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 24 Aug 2007 14:39:25 +0000 Subject: (byte-optimize-if): Don't presume `clause' is a list. --- lisp/ChangeLog | 9 +++++++-- lisp/emacs-lisp/byte-opt.el | 4 +++- 2 files changed, 10 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a97ee9a2621..4601d4a6d76 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2007-08-24 Stefan Monnier + + * emacs-lisp/byte-opt.el (byte-optimize-if): Don't presume `clause' is + a list. + 2007-08-24 Thien-Thi Nguyen * progmodes/hideshow.el (hs-match-data): Delete alias. @@ -39,8 +44,8 @@ 2007-08-23 Masatake YAMATO - * progmodes/cc-fonts.el (gtkdoc-font-lock-doc-comments): Highlight - name of parameters in document body. + * progmodes/cc-fonts.el (gtkdoc-font-lock-doc-comments): + Highlight name of parameters in document body. 2007-08-23 Stefan Monnier diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b4eaf4ff5eb..80a6ad595b2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1020,7 +1020,9 @@ ;; (if nil ) ==> (if (not ) (progn )) ;; (if nil) ==> (if ) (let ((clause (nth 1 form))) - (cond ((eq (car clause) 'progn) + (cond ((and (eq (car-safe clause) 'progn) + ;; `clause' is a proper list. + (null (cdr (last clause)))) (if (null (cddr clause)) ;; A trivial `progn'. (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) -- cgit v1.2.3 From 1e38b8ffcda998f58be1d33dc35ec83e75ff9749 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 01:05:44 +0000 Subject: Initial revision, comprising elib-node.el and avltree.el, with minimum modifications for standalone-compilation. --- lisp/emacs-lisp/avl-tree.el | 715 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 715 insertions(+) create mode 100644 lisp/emacs-lisp/avl-tree.el (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el new file mode 100644 index 00000000000..59ce6f891ce --- /dev/null +++ b/lisp/emacs-lisp/avl-tree.el @@ -0,0 +1,715 @@ +;;;; $Id: elib-node.el,v 0.8 1995/12/11 00:11:19 ceder Exp $ +;;;; Nodes used in binary trees and doubly linked lists. + +;; Copyright (C) 1991-1995 Free Software Foundation + +;; Author: Per Cederqvist +;; Inge Wallin +;; Maintainer: elib-maintainers@lysator.liu.se +;; Created: 20 May 1991 +;; Keywords: extensions, lisp + +;;;; This file is part of the GNU Emacs lisp library, Elib. +;;;; +;;;; GNU Elib is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; GNU Elib is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with GNU Elib; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;;; Boston, MA 02111-1307, USA +;;;; +;;;; Author: Inge Wallin +;;;; + +;;; Commentary: + +;;; A node is implemented as an array with three elements, using +;;; (elt node 0) as the left pointer +;;; (elt node 1) as the right pointer +;;; (elt node 2) as the data +;;; +;;; Some types of trees, e.g. AVL trees, need bigger nodes, but +;;; as long as the first three parts are the left pointer, the +;;; right pointer and the data field, these macros can be used. +;;; + +;;; Code: + +;;; Begin HACKS to make avl-tree.el standalone. +;;; +;;; 0/ Don't do this. +;;; (provide 'elib-node) +;;; +;;; End HACKS to make avl-tree.el standalone. + + +(defmacro elib-node-create (left right data) + + ;; Create a tree node from LEFT, RIGHT and DATA. + (` (vector (, left) (, right) (, data)))) + + +(defmacro elib-node-left (node) + + ;; Return the left pointer of NODE. + (` (aref (, node) 0))) + + +(defmacro elib-node-right (node) + + ;; Return the right pointer of NODE. + (` (aref (, node) 1))) + + +(defmacro elib-node-data (node) + + ;; Return the data of NODE. + (` (aref (, node) 2))) + + +(defmacro elib-node-set-left (node newleft) + + ;; Set the left pointer of NODE to NEWLEFT. + (` (aset (, node) 0 (, newleft)))) + + +(defmacro elib-node-set-right (node newright) + + ;; Set the right pointer of NODE to NEWRIGHT. + (` (aset (, node) 1 (, newright)))) + + +(defmacro elib-node-set-data (node newdata) + ;; Set the data of NODE to NEWDATA. + (` (aset (, node) 2 (, newdata)))) + + + +(defmacro elib-node-branch (node branch) + + ;; Get value of a branch of a node. + ;; + ;; NODE is the node, and BRANCH is the branch. + ;; 0 for left pointer, 1 for right pointer and 2 for the data." + (` (aref (, node) (, branch)))) + + +(defmacro elib-node-set-branch (node branch newval) + + ;; Set value of a branch of a node. + ;; + ;; NODE is the node, and BRANCH is the branch. + ;; 0 for left pointer, 1 for the right pointer and 2 for the data. + ;; NEWVAL is new value of the branch." + (` (aset (, node) (, branch) (, newval)))) + +;;; elib-node.el ends here. +;;;; $Id: avltree.el,v 0.8 1995/12/11 00:10:54 ceder Exp $ +;;;; This file implements balanced binary trees, AVL-trees. + +;; Copyright (C) 1991-1995 Free Software Foundation + +;; Author: Inge Wallin +;; Thomas Bellman +;; Maintainer: elib-maintainers@lysator.liu.se +;; Created: 10 May 1991 +;; Keywords: extensions, lisp + +;;;; This file is part of the GNU Emacs lisp library, Elib. +;;;; +;;;; GNU Elib is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; GNU Elib is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with GNU Elib; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;;; Boston, MA 02111-1307, USA +;;;; +;;;; Initial author: Thomas Bellman +;;;; Lysator Computer Club +;;;; Linkoping University +;;;; Sweden +;;;; +;;;; Bugfixes and completion: Inge Wallin +;;;; + + +;;; Commentary: +;;; +;;; An AVL tree is a nearly-perfect balanced binary tree. A tree +;;; consists of two cons cells, the first one holding the tag +;;; 'AVLTREE in the car cell, and the second one having the tree +;;; in the car and the compare function in the cdr cell. The tree has +;;; a dummy node as its root with the real tree in the left pointer. +;;; +;;; Each node of the tree consists of one data element, one left +;;; sub-tree and one right sub-tree. Each node also has a balance +;;; count, which is the difference in depth of the left and right +;;; sub-trees. +;;; + +;;; Code: + +;;; Begin HACKS to make avl-tree.el standalone. +;;; +;;; 1/ See above for inlined elib-node.el. +;;; (require 'elib-node) +;;; +;;; 2/ This requirement has been replaced w/ new code. +;;; (require 'stack-m) +;;; +;;; 3/ New code: +(eval-when-compile (require 'cl)) +(defun elib-stack-create () (list)) +(defmacro elib-stack-push (stack object) `(push ,object ,stack)) +(defmacro elib-stack-pop (stack) `(pop ,stack)) +;;; +;;; 4/ Provide `avl-tree' instead of `avltree'. +(provide 'avl-tree) +;;; +;;; End HACKS to make avl-tree.el standalone. + + +;;; ================================================================ +;;; Functions and macros handling an AVL tree node. + +;; +;; The rest of the functions needed here can be found in +;; elib-node.el. +;; + + +(defmacro elib-avl-node-create (left right data balance) + + ;; Create and return an avl-tree node. + (` (vector (, left) (, right) (, data) (, balance)))) + + +(defmacro elib-avl-node-balance (node) + + ;; Return the balance field of a node. + (` (aref (, node) 3))) + + +(defmacro elib-avl-node-set-balance (node newbal) + + ;; Set the balance field of a node. + (` (aset (, node) 3 (, newbal)))) + + + +;;; ================================================================ +;;; Internal functions for use in the AVL tree package + +;;; +;;; The functions and macros in this section all start with `elib-avl-'. +;;; + + +(defmacro elib-avl-root (tree) + + ;; Return the root node for an avl-tree. INTERNAL USE ONLY. + (` (elib-node-left (car (cdr (, tree)))))) + + +(defmacro elib-avl-dummyroot (tree) + + ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. + + (` (car (cdr (, tree))))) + + +(defmacro elib-avl-cmpfun (tree) + + ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. + (` (cdr (cdr (, tree))))) + + +;; ---------------------------------------------------------------- +;; Deleting data + + +(defun elib-avl-del-balance1 (node branch) + + ;; Rebalance a tree and return t if the height of the tree has shrunk. + (let* ((br (elib-node-branch node branch)) + p1 + b1 + p2 + b2 + result) + (cond + ((< (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br 0) + t) + + ((= (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br +1) + nil) + + (t ; Rebalance + (setq p1 (elib-node-right br) + b1 (elib-avl-node-balance p1)) + (if (>= b1 0) + ;; Single RR rotation + (progn + (elib-node-set-right br (elib-node-left p1)) + (elib-node-set-left p1 br) + (if (= 0 b1) + (progn + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance p1 -1) + (setq result nil)) + (elib-avl-node-set-balance br 0) + (elib-avl-node-set-balance p1 0) + (setq result t)) + (elib-node-set-branch node branch p1) + result) + + ;; Double RL rotation + (setq p2 (elib-node-left p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-left p1 (elib-node-right p2)) + (elib-node-set-right p2 p1) + (elib-node-set-right br (elib-node-left p2)) + (elib-node-set-left p2 br) + (if (> b2 0) + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance br 0)) + (if (< b2 0) + (elib-avl-node-set-balance p1 +1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2) + (elib-avl-node-set-balance p2 0) + t) + )) + )) + + +(defun elib-avl-del-balance2 (node branch) + + (let* ((br (elib-node-branch node branch)) + p1 + b1 + p2 + b2 + result) + (cond + ((> (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br 0) + t) + + ((= (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br -1) + nil) + + (t ; Rebalance + (setq p1 (elib-node-left br) + b1 (elib-avl-node-balance p1)) + (if (<= b1 0) + ;; Single LL rotation + (progn + (elib-node-set-left br (elib-node-right p1)) + (elib-node-set-right p1 br) + (if (= 0 b1) + (progn + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance p1 +1) + (setq result nil)) + (elib-avl-node-set-balance br 0) + (elib-avl-node-set-balance p1 0) + (setq result t)) + (elib-node-set-branch node branch p1) + result) + + ;; Double LR rotation + (setq p2 (elib-node-right p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-right p1 (elib-node-left p2)) + (elib-node-set-left p2 p1) + (elib-node-set-left br (elib-node-right p2)) + (elib-node-set-right p2 br) + (if (< b2 0) + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance br 0)) + (if (> b2 0) + (elib-avl-node-set-balance p1 -1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2) + (elib-avl-node-set-balance p2 0) + t) + )) + )) + + +(defun elib-avl-do-del-internal (node branch q) + + (let* ((br (elib-node-branch node branch))) + (if (elib-node-right br) + (if (elib-avl-do-del-internal br +1 q) + (elib-avl-del-balance2 node branch)) + (elib-node-set-data q (elib-node-data br)) + (elib-node-set-branch node branch + (elib-node-left br)) + t))) + + + +(defun elib-avl-do-delete (cmpfun root branch data) + + ;; Return t if the height of the tree has shrunk. + (let* ((br (elib-node-branch root branch))) + (cond + ((null br) + nil) + + ((funcall cmpfun data (elib-node-data br)) + (if (elib-avl-do-delete cmpfun br 0 data) + (elib-avl-del-balance1 root branch))) + + ((funcall cmpfun (elib-node-data br) data) + (if (elib-avl-do-delete cmpfun br 1 data) + (elib-avl-del-balance2 root branch))) + + (t + ;; Found it. Let's delete it. + (cond + ((null (elib-node-right br)) + (elib-node-set-branch root branch (elib-node-left br)) + t) + + ((null (elib-node-left br)) + (elib-node-set-branch root branch (elib-node-right br)) + t) + + (t + (if (elib-avl-do-del-internal br 0 br) + (elib-avl-del-balance1 root branch))))) + ))) + + +;; ---------------------------------------------------------------- +;; Entering data + + + +(defun elib-avl-enter-balance1 (node branch) + + ;; Rebalance a tree and return t if the height of the tree has grown. + (let* ((br (elib-node-branch node branch)) + p1 + p2 + b2 + result) + (cond + ((< (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br 0) + nil) + + ((= (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br +1) + t) + + (t + ;; Tree has grown => Rebalance + (setq p1 (elib-node-right br)) + (if (> (elib-avl-node-balance p1) 0) + ;; Single RR rotation + (progn + (elib-node-set-right br (elib-node-left p1)) + (elib-node-set-left p1 br) + (elib-avl-node-set-balance br 0) + (elib-node-set-branch node branch p1)) + + ;; Double RL rotation + (setq p2 (elib-node-left p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-left p1 (elib-node-right p2)) + (elib-node-set-right p2 p1) + (elib-node-set-right br (elib-node-left p2)) + (elib-node-set-left p2 br) + (if (> b2 0) + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance br 0)) + (if (< b2 0) + (elib-avl-node-set-balance p1 +1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2)) + (elib-avl-node-set-balance (elib-node-branch node branch) 0) + nil)) + )) + + +(defun elib-avl-enter-balance2 (node branch) + + ;; Return t if the tree has grown. + (let* ((br (elib-node-branch node branch)) + p1 + p2 + b2) + (cond + ((> (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br 0) + nil) + + ((= (elib-avl-node-balance br) 0) + (elib-avl-node-set-balance br -1) + t) + + (t + ;; Balance was -1 => Rebalance + (setq p1 (elib-node-left br)) + (if (< (elib-avl-node-balance p1) 0) + ;; Single LL rotation + (progn + (elib-node-set-left br (elib-node-right p1)) + (elib-node-set-right p1 br) + (elib-avl-node-set-balance br 0) + (elib-node-set-branch node branch p1)) + + ;; Double LR rotation + (setq p2 (elib-node-right p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-right p1 (elib-node-left p2)) + (elib-node-set-left p2 p1) + (elib-node-set-left br (elib-node-right p2)) + (elib-node-set-right p2 br) + (if (< b2 0) + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance br 0)) + (if (> b2 0) + (elib-avl-node-set-balance p1 -1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2)) + (elib-avl-node-set-balance (elib-node-branch node branch) 0) + nil)) + )) + + +(defun elib-avl-do-enter (cmpfun root branch data) + + ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. + (let ((br (elib-node-branch root branch))) + (cond + ((null br) + ;; Data not in tree, insert it + (elib-node-set-branch root branch + (elib-avl-node-create nil nil data 0)) + t) + + ((funcall cmpfun data (elib-node-data br)) + (and (elib-avl-do-enter cmpfun + br + 0 data) + (elib-avl-enter-balance2 root branch))) + + ((funcall cmpfun (elib-node-data br) data) + (and (elib-avl-do-enter cmpfun + br + 1 data) + (elib-avl-enter-balance1 root branch))) + + (t + (elib-node-set-data br data) + nil)))) + + +;; ---------------------------------------------------------------- + + +(defun elib-avl-mapc (map-function root) + ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. + ;; The function is applied in-order. + ;; + ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. + ;; INTERNAL USE ONLY. + + (let ((node root) + (stack (elib-stack-create)) + (go-left t)) + (elib-stack-push stack nil) + (while node + (if (and go-left + (elib-node-left node)) + (progn ; Do the left subtree first. + (elib-stack-push stack node) + (setq node (elib-node-left node))) + (funcall map-function node) ; Apply the function... + (if (elib-node-right node) ; and do the right subtree. + (setq node (elib-node-right node) + go-left t) + (setq node (elib-stack-pop stack) + go-left nil)))))) + + +(defun elib-avl-do-copy (root) + ;; Copy the tree with ROOT as root. + ;; Highly recursive. INTERNAL USE ONLY. + (if (null root) + nil + (elib-avl-node-create (elib-avl-do-copy (elib-node-left root)) + (elib-avl-do-copy (elib-node-right root)) + (elib-node-data root) + (elib-avl-node-balance root)))) + + + +;;; ================================================================ +;;; The public functions which operate on AVL trees. + + +(defun avltree-create (compare-function) + "Create an empty avl tree. +COMPARE-FUNCTION is a function which takes two arguments, A and B, +and returns non-nil if A is less than B, and nil otherwise." + (cons 'AVLTREE + (cons (elib-avl-node-create nil nil nil 0) + compare-function))) + + +(defun avltree-p (obj) + "Return t if OBJ is an avl tree, nil otherwise." + (eq (car-safe obj) 'AVLTREE)) + + +(defun avltree-compare-function (tree) + "Return the comparision function for the avl tree TREE." + (elib-avl-cmpfun tree)) + + +(defun avltree-empty (tree) + "Return t if TREE is emtpy, otherwise return nil." + (null (elib-avl-root tree))) + + +(defun avltree-enter (tree data) + "In the avl tree TREE insert DATA. +Return DATA." + + (elib-avl-do-enter (elib-avl-cmpfun tree) + (elib-avl-dummyroot tree) + 0 + data) + data) + + +(defun avltree-delete (tree data) + "From the avl tree TREE, delete DATA. +Return the element in TREE which matched DATA, nil if no element matched." + + (elib-avl-do-delete (elib-avl-cmpfun tree) + (elib-avl-dummyroot tree) + 0 + data)) + + +(defun avltree-member (tree data) + "Return the element in the avl tree TREE which matches DATA. +Matching uses the compare function previously specified in `avltree-create' +when TREE was created. + +If there is no such element in the tree, the value is nil." + + (let ((node (elib-avl-root tree)) + (compare-function (elib-avl-cmpfun tree)) + found) + (while (and node + (not found)) + (cond + ((funcall compare-function data (elib-node-data node)) + (setq node (elib-node-left node))) + ((funcall compare-function (elib-node-data node) data) + (setq node (elib-node-right node))) + (t + (setq found t)))) + + (if node + (elib-node-data node) + nil))) + + + +(defun avltree-map (__map-function__ tree) + "Apply MAP-FUNCTION to all elements in the avl tree TREE." + (elib-avl-mapc + (function (lambda (node) + (elib-node-set-data node + (funcall __map-function__ + (elib-node-data node))))) + (elib-avl-root tree))) + + + +(defun avltree-first (tree) + "Return the first element in TREE, or nil if TREE is empty." + + (let ((node (elib-avl-root tree))) + (if node + (progn + (while (elib-node-left node) + (setq node (elib-node-left node))) + (elib-node-data node)) + nil))) + + +(defun avltree-last (tree) + "Return the last element in TREE, or nil if TREE is empty." + (let ((node (elib-avl-root tree))) + (if node + (progn + (while (elib-node-right node) + (setq node (elib-node-right node))) + (elib-node-data node)) + nil))) + + +(defun avltree-copy (tree) + "Return a copy of the avl tree TREE." + (let ((new-tree (avltree-create + (elib-avl-cmpfun tree)))) + (elib-node-set-left (elib-avl-dummyroot new-tree) + (elib-avl-do-copy (elib-avl-root tree))) + new-tree)) + + +(defun avltree-flatten (tree) + "Return a sorted list containing all elements of TREE." + (nreverse + (let ((treelist nil)) + (elib-avl-mapc (function (lambda (node) + (setq treelist (cons (elib-node-data node) + treelist)))) + (elib-avl-root tree)) + treelist))) + + +(defun avltree-size (tree) + "Return the number of elements in TREE." + (let ((treesize 0)) + (elib-avl-mapc (function (lambda (data) + (setq treesize (1+ treesize)) + data)) + (elib-avl-root tree)) + treesize)) + + +(defun avltree-clear (tree) + "Clear the avl tree TREE." + (elib-node-set-left (elib-avl-dummyroot tree) nil)) + +;;; avltree.el ends here -- cgit v1.2.3 From b74e26bbe218674e310249a3cd233dcf4a84850a Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 01:28:07 +0000 Subject: Munge comments, whitespace, indentation, hanging parens; nfc. --- lisp/emacs-lisp/avl-tree.el | 649 +++++++++++++++++--------------------------- 1 file changed, 252 insertions(+), 397 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 59ce6f891ce..75ec86c0d0e 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -1,109 +1,95 @@ -;;;; $Id: elib-node.el,v 0.8 1995/12/11 00:11:19 ceder Exp $ -;;;; Nodes used in binary trees and doubly linked lists. +;;; avl-tree.el --- balanced binary trees, AVL-trees -;; Copyright (C) 1991-1995 Free Software Foundation +;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. ;; Author: Per Cederqvist ;; Inge Wallin -;; Maintainer: elib-maintainers@lysator.liu.se -;; Created: 20 May 1991 -;; Keywords: extensions, lisp - -;;;; This file is part of the GNU Emacs lisp library, Elib. -;;;; -;;;; GNU Elib is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; GNU Elib is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with GNU Elib; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;;; Boston, MA 02111-1307, USA -;;;; -;;;; Author: Inge Wallin -;;;; +;; Thomas Bellman +;; Maintainer: FSF +;; Created: 10 May 1991 +;; Keywords: extensions, data structures -;;; Commentary: +;; This file is part of GNU Emacs. -;;; A node is implemented as an array with three elements, using -;;; (elt node 0) as the left pointer -;;; (elt node 1) as the right pointer -;;; (elt node 2) as the data -;;; -;;; Some types of trees, e.g. AVL trees, need bigger nodes, but -;;; as long as the first three parts are the left pointer, the -;;; right pointer and the data field, these macros can be used. -;;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. -;;; Code: +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. -;;; Begin HACKS to make avl-tree.el standalone. -;;; -;;; 0/ Don't do this. -;;; (provide 'elib-node) -;;; -;;; End HACKS to make avl-tree.el standalone. +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;; Commentary: -(defmacro elib-node-create (left right data) +;; This file combines elib-node.el and avltree.el from Elib. +;; +;; * Comments from elib-node.el +;; A node is implemented as an array with three elements, using +;; (elt node 0) as the left pointer +;; (elt node 1) as the right pointer +;; (elt node 2) as the data +;; +;; Some types of trees, e.g. AVL trees, need bigger nodes, but +;; as long as the first three parts are the left pointer, the +;; right pointer and the data field, these macros can be used. +;; +;; * Comments from avltree.el +;; An AVL tree is a nearly-perfect balanced binary tree. A tree +;; consists of two cons cells, the first one holding the tag +;; 'AVLTREE in the car cell, and the second one having the tree +;; in the car and the compare function in the cdr cell. The tree has +;; a dummy node as its root with the real tree in the left pointer. +;; +;; Each node of the tree consists of one data element, one left +;; sub-tree and one right sub-tree. Each node also has a balance +;; count, which is the difference in depth of the left and right +;; sub-trees. +;;; Code: + +(defmacro elib-node-create (left right data) ;; Create a tree node from LEFT, RIGHT and DATA. (` (vector (, left) (, right) (, data)))) - (defmacro elib-node-left (node) - ;; Return the left pointer of NODE. (` (aref (, node) 0))) - (defmacro elib-node-right (node) - ;; Return the right pointer of NODE. (` (aref (, node) 1))) - (defmacro elib-node-data (node) - ;; Return the data of NODE. (` (aref (, node) 2))) - (defmacro elib-node-set-left (node newleft) - ;; Set the left pointer of NODE to NEWLEFT. (` (aset (, node) 0 (, newleft)))) - (defmacro elib-node-set-right (node newright) - ;; Set the right pointer of NODE to NEWRIGHT. (` (aset (, node) 1 (, newright)))) - (defmacro elib-node-set-data (node newdata) ;; Set the data of NODE to NEWDATA. (` (aset (, node) 2 (, newdata)))) - - (defmacro elib-node-branch (node branch) - ;; Get value of a branch of a node. ;; ;; NODE is the node, and BRANCH is the branch. ;; 0 for left pointer, 1 for right pointer and 2 for the data." (` (aref (, node) (, branch)))) - (defmacro elib-node-set-branch (node branch newval) - ;; Set value of a branch of a node. ;; ;; NODE is the node, and BRANCH is the branch. @@ -111,107 +97,27 @@ ;; NEWVAL is new value of the branch." (` (aset (, node) (, branch) (, newval)))) -;;; elib-node.el ends here. -;;;; $Id: avltree.el,v 0.8 1995/12/11 00:10:54 ceder Exp $ -;;;; This file implements balanced binary trees, AVL-trees. - -;; Copyright (C) 1991-1995 Free Software Foundation - -;; Author: Inge Wallin -;; Thomas Bellman -;; Maintainer: elib-maintainers@lysator.liu.se -;; Created: 10 May 1991 -;; Keywords: extensions, lisp - -;;;; This file is part of the GNU Emacs lisp library, Elib. -;;;; -;;;; GNU Elib is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2, or (at your option) -;;;; any later version. -;;;; -;;;; GNU Elib is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with GNU Elib; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;;; Boston, MA 02111-1307, USA -;;;; -;;;; Initial author: Thomas Bellman -;;;; Lysator Computer Club -;;;; Linkoping University -;;;; Sweden -;;;; -;;;; Bugfixes and completion: Inge Wallin -;;;; - - -;;; Commentary: -;;; -;;; An AVL tree is a nearly-perfect balanced binary tree. A tree -;;; consists of two cons cells, the first one holding the tag -;;; 'AVLTREE in the car cell, and the second one having the tree -;;; in the car and the compare function in the cdr cell. The tree has -;;; a dummy node as its root with the real tree in the left pointer. -;;; -;;; Each node of the tree consists of one data element, one left -;;; sub-tree and one right sub-tree. Each node also has a balance -;;; count, which is the difference in depth of the left and right -;;; sub-trees. -;;; - -;;; Code: - -;;; Begin HACKS to make avl-tree.el standalone. -;;; -;;; 1/ See above for inlined elib-node.el. -;;; (require 'elib-node) -;;; -;;; 2/ This requirement has been replaced w/ new code. -;;; (require 'stack-m) -;;; -;;; 3/ New code: (eval-when-compile (require 'cl)) (defun elib-stack-create () (list)) (defmacro elib-stack-push (stack object) `(push ,object ,stack)) (defmacro elib-stack-pop (stack) `(pop ,stack)) -;;; -;;; 4/ Provide `avl-tree' instead of `avltree'. (provide 'avl-tree) -;;; -;;; End HACKS to make avl-tree.el standalone. - ;;; ================================================================ ;;; Functions and macros handling an AVL tree node. -;; -;; The rest of the functions needed here can be found in -;; elib-node.el. -;; - - (defmacro elib-avl-node-create (left right data balance) - ;; Create and return an avl-tree node. (` (vector (, left) (, right) (, data) (, balance)))) - (defmacro elib-avl-node-balance (node) - ;; Return the balance field of a node. (` (aref (, node) 3))) - (defmacro elib-avl-node-set-balance (node newbal) - ;; Set the balance field of a node. (` (aset (, node) 3 (, newbal)))) - ;;; ================================================================ ;;; Internal functions for use in the AVL tree package @@ -220,39 +126,29 @@ ;;; The functions and macros in this section all start with `elib-avl-'. ;;; - (defmacro elib-avl-root (tree) - ;; Return the root node for an avl-tree. INTERNAL USE ONLY. (` (elib-node-left (car (cdr (, tree)))))) - (defmacro elib-avl-dummyroot (tree) - ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. - (` (car (cdr (, tree))))) - (defmacro elib-avl-cmpfun (tree) - ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. (` (cdr (cdr (, tree))))) - ;; ---------------------------------------------------------------- ;; Deleting data - (defun elib-avl-del-balance1 (node branch) - ;; Rebalance a tree and return t if the height of the tree has shrunk. (let* ((br (elib-node-branch node branch)) - p1 - b1 - p2 - b2 - result) + p1 + b1 + p2 + b2 + result) (cond ((< (elib-avl-node-balance br) 0) (elib-avl-node-set-balance br 0) @@ -262,53 +158,50 @@ (elib-avl-node-set-balance br +1) nil) - (t ; Rebalance + (t + ;; Rebalance. (setq p1 (elib-node-right br) - b1 (elib-avl-node-balance p1)) + b1 (elib-avl-node-balance p1)) (if (>= b1 0) - ;; Single RR rotation - (progn - (elib-node-set-right br (elib-node-left p1)) - (elib-node-set-left p1 br) - (if (= 0 b1) - (progn - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance p1 -1) - (setq result nil)) - (elib-avl-node-set-balance br 0) - (elib-avl-node-set-balance p1 0) - (setq result t)) - (elib-node-set-branch node branch p1) - result) - - ;; Double RL rotation - (setq p2 (elib-node-left p1) - b2 (elib-avl-node-balance p2)) - (elib-node-set-left p1 (elib-node-right p2)) - (elib-node-set-right p2 p1) - (elib-node-set-right br (elib-node-left p2)) - (elib-node-set-left p2 br) - (if (> b2 0) - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance br 0)) - (if (< b2 0) - (elib-avl-node-set-balance p1 +1) - (elib-avl-node-set-balance p1 0)) - (elib-node-set-branch node branch p2) - (elib-avl-node-set-balance p2 0) - t) - )) - )) - + ;; Single RR rotation. + (progn + (elib-node-set-right br (elib-node-left p1)) + (elib-node-set-left p1 br) + (if (= 0 b1) + (progn + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance p1 -1) + (setq result nil)) + (elib-avl-node-set-balance br 0) + (elib-avl-node-set-balance p1 0) + (setq result t)) + (elib-node-set-branch node branch p1) + result) + + ;; Double RL rotation. + (setq p2 (elib-node-left p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-left p1 (elib-node-right p2)) + (elib-node-set-right p2 p1) + (elib-node-set-right br (elib-node-left p2)) + (elib-node-set-left p2 br) + (if (> b2 0) + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance br 0)) + (if (< b2 0) + (elib-avl-node-set-balance p1 +1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2) + (elib-avl-node-set-balance p2 0) + t))))) (defun elib-avl-del-balance2 (node branch) - (let* ((br (elib-node-branch node branch)) - p1 - b1 - p2 - b2 - result) + p1 + b1 + p2 + b2 + result) (cond ((> (elib-avl-node-balance br) 0) (elib-avl-node-set-balance br 0) @@ -318,60 +211,55 @@ (elib-avl-node-set-balance br -1) nil) - (t ; Rebalance + (t + ;; Rebalance. (setq p1 (elib-node-left br) - b1 (elib-avl-node-balance p1)) + b1 (elib-avl-node-balance p1)) (if (<= b1 0) - ;; Single LL rotation - (progn - (elib-node-set-left br (elib-node-right p1)) - (elib-node-set-right p1 br) - (if (= 0 b1) - (progn - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance p1 +1) - (setq result nil)) - (elib-avl-node-set-balance br 0) - (elib-avl-node-set-balance p1 0) - (setq result t)) - (elib-node-set-branch node branch p1) - result) - - ;; Double LR rotation - (setq p2 (elib-node-right p1) - b2 (elib-avl-node-balance p2)) - (elib-node-set-right p1 (elib-node-left p2)) - (elib-node-set-left p2 p1) - (elib-node-set-left br (elib-node-right p2)) - (elib-node-set-right p2 br) - (if (< b2 0) - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance br 0)) - (if (> b2 0) - (elib-avl-node-set-balance p1 -1) - (elib-avl-node-set-balance p1 0)) - (elib-node-set-branch node branch p2) - (elib-avl-node-set-balance p2 0) - t) - )) - )) - + ;; Single LL rotation. + (progn + (elib-node-set-left br (elib-node-right p1)) + (elib-node-set-right p1 br) + (if (= 0 b1) + (progn + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance p1 +1) + (setq result nil)) + (elib-avl-node-set-balance br 0) + (elib-avl-node-set-balance p1 0) + (setq result t)) + (elib-node-set-branch node branch p1) + result) + + ;; Double LR rotation. + (setq p2 (elib-node-right p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-right p1 (elib-node-left p2)) + (elib-node-set-left p2 p1) + (elib-node-set-left br (elib-node-right p2)) + (elib-node-set-right p2 br) + (if (< b2 0) + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance br 0)) + (if (> b2 0) + (elib-avl-node-set-balance p1 -1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2) + (elib-avl-node-set-balance p2 0) + t))))) (defun elib-avl-do-del-internal (node branch q) (let* ((br (elib-node-branch node branch))) - (if (elib-node-right br) - (if (elib-avl-do-del-internal br +1 q) - (elib-avl-del-balance2 node branch)) - (elib-node-set-data q (elib-node-data br)) - (elib-node-set-branch node branch - (elib-node-left br)) - t))) - - + (if (elib-node-right br) + (if (elib-avl-do-del-internal br +1 q) + (elib-avl-del-balance2 node branch)) + (elib-node-set-data q (elib-node-data br)) + (elib-node-set-branch node branch + (elib-node-left br)) + t))) (defun elib-avl-do-delete (cmpfun root branch data) - ;; Return t if the height of the tree has shrunk. (let* ((br (elib-node-branch root branch))) (cond @@ -380,42 +268,37 @@ ((funcall cmpfun data (elib-node-data br)) (if (elib-avl-do-delete cmpfun br 0 data) - (elib-avl-del-balance1 root branch))) + (elib-avl-del-balance1 root branch))) ((funcall cmpfun (elib-node-data br) data) (if (elib-avl-do-delete cmpfun br 1 data) - (elib-avl-del-balance2 root branch))) + (elib-avl-del-balance2 root branch))) (t ;; Found it. Let's delete it. (cond ((null (elib-node-right br)) - (elib-node-set-branch root branch (elib-node-left br)) - t) + (elib-node-set-branch root branch (elib-node-left br)) + t) ((null (elib-node-left br)) - (elib-node-set-branch root branch (elib-node-right br)) - t) + (elib-node-set-branch root branch (elib-node-right br)) + t) (t - (if (elib-avl-do-del-internal br 0 br) - (elib-avl-del-balance1 root branch))))) - ))) - + (if (elib-avl-do-del-internal br 0 br) + (elib-avl-del-balance1 root branch)))))))) ;; ---------------------------------------------------------------- ;; Entering data - - (defun elib-avl-enter-balance1 (node branch) - ;; Rebalance a tree and return t if the height of the tree has grown. (let* ((br (elib-node-branch node branch)) - p1 - p2 - b2 - result) + p1 + p2 + b2 + result) (cond ((< (elib-avl-node-balance br) 0) (elib-avl-node-set-balance br 0) @@ -426,42 +309,39 @@ t) (t - ;; Tree has grown => Rebalance + ;; Tree has grown => Rebalance. (setq p1 (elib-node-right br)) (if (> (elib-avl-node-balance p1) 0) - ;; Single RR rotation - (progn - (elib-node-set-right br (elib-node-left p1)) - (elib-node-set-left p1 br) - (elib-avl-node-set-balance br 0) - (elib-node-set-branch node branch p1)) - - ;; Double RL rotation - (setq p2 (elib-node-left p1) - b2 (elib-avl-node-balance p2)) - (elib-node-set-left p1 (elib-node-right p2)) - (elib-node-set-right p2 p1) - (elib-node-set-right br (elib-node-left p2)) - (elib-node-set-left p2 br) - (if (> b2 0) - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance br 0)) - (if (< b2 0) - (elib-avl-node-set-balance p1 +1) - (elib-avl-node-set-balance p1 0)) - (elib-node-set-branch node branch p2)) + ;; Single RR rotation. + (progn + (elib-node-set-right br (elib-node-left p1)) + (elib-node-set-left p1 br) + (elib-avl-node-set-balance br 0) + (elib-node-set-branch node branch p1)) + + ;; Double RL rotation. + (setq p2 (elib-node-left p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-left p1 (elib-node-right p2)) + (elib-node-set-right p2 p1) + (elib-node-set-right br (elib-node-left p2)) + (elib-node-set-left p2 br) + (if (> b2 0) + (elib-avl-node-set-balance br -1) + (elib-avl-node-set-balance br 0)) + (if (< b2 0) + (elib-avl-node-set-balance p1 +1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2)) (elib-avl-node-set-balance (elib-node-branch node branch) 0) - nil)) - )) - + nil)))) (defun elib-avl-enter-balance2 (node branch) - ;; Return t if the tree has grown. (let* ((br (elib-node-branch node branch)) - p1 - p2 - b2) + p1 + p2 + b2) (cond ((> (elib-avl-node-balance br) 0) (elib-avl-node-set-balance br 0) @@ -472,90 +352,86 @@ t) (t - ;; Balance was -1 => Rebalance + ;; Balance was -1 => Rebalance. (setq p1 (elib-node-left br)) (if (< (elib-avl-node-balance p1) 0) - ;; Single LL rotation - (progn - (elib-node-set-left br (elib-node-right p1)) - (elib-node-set-right p1 br) - (elib-avl-node-set-balance br 0) - (elib-node-set-branch node branch p1)) - - ;; Double LR rotation - (setq p2 (elib-node-right p1) - b2 (elib-avl-node-balance p2)) - (elib-node-set-right p1 (elib-node-left p2)) - (elib-node-set-left p2 p1) - (elib-node-set-left br (elib-node-right p2)) - (elib-node-set-right p2 br) - (if (< b2 0) - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance br 0)) - (if (> b2 0) - (elib-avl-node-set-balance p1 -1) - (elib-avl-node-set-balance p1 0)) - (elib-node-set-branch node branch p2)) + ;; Single LL rotation. + (progn + (elib-node-set-left br (elib-node-right p1)) + (elib-node-set-right p1 br) + (elib-avl-node-set-balance br 0) + (elib-node-set-branch node branch p1)) + + ;; Double LR rotation. + (setq p2 (elib-node-right p1) + b2 (elib-avl-node-balance p2)) + (elib-node-set-right p1 (elib-node-left p2)) + (elib-node-set-left p2 p1) + (elib-node-set-left br (elib-node-right p2)) + (elib-node-set-right p2 br) + (if (< b2 0) + (elib-avl-node-set-balance br +1) + (elib-avl-node-set-balance br 0)) + (if (> b2 0) + (elib-avl-node-set-balance p1 -1) + (elib-avl-node-set-balance p1 0)) + (elib-node-set-branch node branch p2)) (elib-avl-node-set-balance (elib-node-branch node branch) 0) - nil)) - )) - + nil)))) (defun elib-avl-do-enter (cmpfun root branch data) - ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. (let ((br (elib-node-branch root branch))) (cond ((null br) - ;; Data not in tree, insert it + ;; Data not in tree, insert it. (elib-node-set-branch root branch - (elib-avl-node-create nil nil data 0)) + (elib-avl-node-create nil nil data 0)) t) ((funcall cmpfun data (elib-node-data br)) (and (elib-avl-do-enter cmpfun - br - 0 data) - (elib-avl-enter-balance2 root branch))) + br + 0 data) + (elib-avl-enter-balance2 root branch))) ((funcall cmpfun (elib-node-data br) data) (and (elib-avl-do-enter cmpfun - br - 1 data) - (elib-avl-enter-balance1 root branch))) + br + 1 data) + (elib-avl-enter-balance1 root branch))) (t (elib-node-set-data br data) nil)))) - ;; ---------------------------------------------------------------- - (defun elib-avl-mapc (map-function root) ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. ;; The function is applied in-order. ;; ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. ;; INTERNAL USE ONLY. - (let ((node root) - (stack (elib-stack-create)) - (go-left t)) + (stack (elib-stack-create)) + (go-left t)) (elib-stack-push stack nil) (while node (if (and go-left - (elib-node-left node)) - (progn ; Do the left subtree first. - (elib-stack-push stack node) - (setq node (elib-node-left node))) - (funcall map-function node) ; Apply the function... - (if (elib-node-right node) ; and do the right subtree. - (setq node (elib-node-right node) - go-left t) - (setq node (elib-stack-pop stack) - go-left nil)))))) - + (elib-node-left node)) + ;; Do the left subtree first. + (progn + (elib-stack-push stack node) + (setq node (elib-node-left node))) + ;; Apply the function... + (funcall map-function node) + ;; and do the right subtree. + (if (elib-node-right node) + (setq node (elib-node-right node) + go-left t) + (setq node (elib-stack-pop stack) + go-left nil)))))) (defun elib-avl-do-copy (root) ;; Copy the tree with ROOT as root. @@ -563,60 +439,50 @@ (if (null root) nil (elib-avl-node-create (elib-avl-do-copy (elib-node-left root)) - (elib-avl-do-copy (elib-node-right root)) - (elib-node-data root) - (elib-avl-node-balance root)))) - + (elib-avl-do-copy (elib-node-right root)) + (elib-node-data root) + (elib-avl-node-balance root)))) ;;; ================================================================ ;;; The public functions which operate on AVL trees. - (defun avltree-create (compare-function) "Create an empty avl tree. COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise." (cons 'AVLTREE - (cons (elib-avl-node-create nil nil nil 0) - compare-function))) - + (cons (elib-avl-node-create nil nil nil 0) + compare-function))) (defun avltree-p (obj) "Return t if OBJ is an avl tree, nil otherwise." (eq (car-safe obj) 'AVLTREE)) - (defun avltree-compare-function (tree) "Return the comparision function for the avl tree TREE." (elib-avl-cmpfun tree)) - (defun avltree-empty (tree) "Return t if TREE is emtpy, otherwise return nil." (null (elib-avl-root tree))) - (defun avltree-enter (tree data) "In the avl tree TREE insert DATA. Return DATA." - (elib-avl-do-enter (elib-avl-cmpfun tree) - (elib-avl-dummyroot tree) - 0 - data) + (elib-avl-dummyroot tree) + 0 + data) data) - (defun avltree-delete (tree data) "From the avl tree TREE, delete DATA. Return the element in TREE which matched DATA, nil if no element matched." - (elib-avl-do-delete (elib-avl-cmpfun tree) - (elib-avl-dummyroot tree) - 0 - data)) - + (elib-avl-dummyroot tree) + 0 + data)) (defun avltree-member (tree data) "Return the element in the avl tree TREE which matches DATA. @@ -624,90 +490,79 @@ Matching uses the compare function previously specified in `avltree-create' when TREE was created. If there is no such element in the tree, the value is nil." - (let ((node (elib-avl-root tree)) - (compare-function (elib-avl-cmpfun tree)) - found) + (compare-function (elib-avl-cmpfun tree)) + found) (while (and node - (not found)) + (not found)) (cond ((funcall compare-function data (elib-node-data node)) - (setq node (elib-node-left node))) + (setq node (elib-node-left node))) ((funcall compare-function (elib-node-data node) data) - (setq node (elib-node-right node))) + (setq node (elib-node-right node))) (t - (setq found t)))) + (setq found t)))) (if node - (elib-node-data node) + (elib-node-data node) nil))) - - (defun avltree-map (__map-function__ tree) "Apply MAP-FUNCTION to all elements in the avl tree TREE." (elib-avl-mapc (function (lambda (node) - (elib-node-set-data node - (funcall __map-function__ - (elib-node-data node))))) + (elib-node-set-data node + (funcall __map-function__ + (elib-node-data node))))) (elib-avl-root tree))) - - (defun avltree-first (tree) "Return the first element in TREE, or nil if TREE is empty." - (let ((node (elib-avl-root tree))) (if node - (progn - (while (elib-node-left node) - (setq node (elib-node-left node))) - (elib-node-data node)) + (progn + (while (elib-node-left node) + (setq node (elib-node-left node))) + (elib-node-data node)) nil))) - (defun avltree-last (tree) "Return the last element in TREE, or nil if TREE is empty." (let ((node (elib-avl-root tree))) (if node - (progn - (while (elib-node-right node) - (setq node (elib-node-right node))) - (elib-node-data node)) + (progn + (while (elib-node-right node) + (setq node (elib-node-right node))) + (elib-node-data node)) nil))) - (defun avltree-copy (tree) "Return a copy of the avl tree TREE." (let ((new-tree (avltree-create - (elib-avl-cmpfun tree)))) + (elib-avl-cmpfun tree)))) (elib-node-set-left (elib-avl-dummyroot new-tree) - (elib-avl-do-copy (elib-avl-root tree))) + (elib-avl-do-copy (elib-avl-root tree))) new-tree)) - (defun avltree-flatten (tree) "Return a sorted list containing all elements of TREE." (nreverse (let ((treelist nil)) (elib-avl-mapc (function (lambda (node) - (setq treelist (cons (elib-node-data node) - treelist)))) - (elib-avl-root tree)) + (setq treelist (cons (elib-node-data node) + treelist)))) + (elib-avl-root tree)) treelist))) - (defun avltree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) (elib-avl-mapc (function (lambda (data) - (setq treesize (1+ treesize)) - data)) - (elib-avl-root tree)) + (setq treesize (1+ treesize)) + data)) + (elib-avl-root tree)) treesize)) - (defun avltree-clear (tree) "Clear the avl tree TREE." (elib-node-set-left (elib-avl-dummyroot tree) nil)) -- cgit v1.2.3 From fb5da2db3e0b8d52337682ce59f397a5ae88869f Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 01:29:41 +0000 Subject: Move provide form to end; nfc. --- lisp/emacs-lisp/avl-tree.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 75ec86c0d0e..604147f618e 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -101,7 +101,6 @@ (defun elib-stack-create () (list)) (defmacro elib-stack-push (stack object) `(push ,object ,stack)) (defmacro elib-stack-pop (stack) `(pop ,stack)) -(provide 'avl-tree) ;;; ================================================================ ;;; Functions and macros handling an AVL tree node. @@ -567,4 +566,6 @@ If there is no such element in the tree, the value is nil." "Clear the avl tree TREE." (elib-node-set-left (elib-avl-dummyroot tree) nil)) +(provide 'avl-tree) + ;;; avltree.el ends here -- cgit v1.2.3 From 25e32569d41466ef97acf433a062c5d02a3601cf Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 01:35:41 +0000 Subject: Don't require `cl'. (elib-stack-create, elib-stack-push, elib-stack-pop): Delete funcs. (elib-avl-mapc): Use `nil' for new stack, and `push' and `pop' directly. --- lisp/emacs-lisp/avl-tree.el | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 604147f618e..b68ebc47de3 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -97,11 +97,6 @@ ;; NEWVAL is new value of the branch." (` (aset (, node) (, branch) (, newval)))) -(eval-when-compile (require 'cl)) -(defun elib-stack-create () (list)) -(defmacro elib-stack-push (stack object) `(push ,object ,stack)) -(defmacro elib-stack-pop (stack) `(pop ,stack)) - ;;; ================================================================ ;;; Functions and macros handling an AVL tree node. @@ -413,15 +408,15 @@ ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. ;; INTERNAL USE ONLY. (let ((node root) - (stack (elib-stack-create)) + (stack nil) (go-left t)) - (elib-stack-push stack nil) + (push nil stack) (while node (if (and go-left (elib-node-left node)) ;; Do the left subtree first. (progn - (elib-stack-push stack node) + (push node stack) (setq node (elib-node-left node))) ;; Apply the function... (funcall map-function node) @@ -429,7 +424,7 @@ (if (elib-node-right node) (setq node (elib-node-right node) go-left t) - (setq node (elib-stack-pop stack) + (setq node (pop stack) go-left nil)))))) (defun elib-avl-do-copy (root) -- cgit v1.2.3 From 37840380aa33f0aa3f4a5bec772586a6e72741c4 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Mon, 27 Aug 2007 01:42:03 +0000 Subject: Add arch tagline --- etc/refcards/pdflayout.sty | 2 ++ lisp/emacs-lisp/avl-tree.el | 1 + 2 files changed, 3 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty index 12b31239bb8..187ffee867b 100644 --- a/etc/refcards/pdflayout.sty +++ b/etc/refcards/pdflayout.sty @@ -45,3 +45,5 @@ \fi % archtag: 63c938a5-cc78-4964-962d-603c90d34afc + +% arch-tag: 3464d27c-1439-473a-bc47-a7c501e8c156 diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index b68ebc47de3..c0408e2dbd2 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -563,4 +563,5 @@ If there is no such element in the tree, the value is nil." (provide 'avl-tree) +;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9 ;;; avltree.el ends here -- cgit v1.2.3 From 85718043eeddf211a3e5b18cc7d31d9a2dd325ad Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 01:44:37 +0000 Subject: Do s/avltree/avl-tree/g. Resulting changed function names: avl-tree-create, avl-tree-p, avl-tree-compare-function, avl-tree-empty, avl-tree-enter, avl-tree-delete, avl-tree-member, avl-tree-map, avl-tree-first, avl-tree-last, avl-tree-copy, avl-tree-flatten, avl-tree-size, avl-tree-clear. Make the symbol used for avl-tree-p `AVL-TREE', as well. --- lisp/emacs-lisp/avl-tree.el | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index c0408e2dbd2..58708f77a14 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -43,7 +43,7 @@ ;; * Comments from avltree.el ;; An AVL tree is a nearly-perfect balanced binary tree. A tree ;; consists of two cons cells, the first one holding the tag -;; 'AVLTREE in the car cell, and the second one having the tree +;; 'AVL-TREE in the car cell, and the second one having the tree ;; in the car and the compare function in the cdr cell. The tree has ;; a dummy node as its root with the real tree in the left pointer. ;; @@ -441,27 +441,27 @@ ;;; ================================================================ ;;; The public functions which operate on AVL trees. -(defun avltree-create (compare-function) +(defun avl-tree-create (compare-function) "Create an empty avl tree. COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise." - (cons 'AVLTREE + (cons 'AVL-TREE (cons (elib-avl-node-create nil nil nil 0) compare-function))) -(defun avltree-p (obj) +(defun avl-tree-p (obj) "Return t if OBJ is an avl tree, nil otherwise." - (eq (car-safe obj) 'AVLTREE)) + (eq (car-safe obj) 'AVL-TREE)) -(defun avltree-compare-function (tree) +(defun avl-tree-compare-function (tree) "Return the comparision function for the avl tree TREE." (elib-avl-cmpfun tree)) -(defun avltree-empty (tree) +(defun avl-tree-empty (tree) "Return t if TREE is emtpy, otherwise return nil." (null (elib-avl-root tree))) -(defun avltree-enter (tree data) +(defun avl-tree-enter (tree data) "In the avl tree TREE insert DATA. Return DATA." (elib-avl-do-enter (elib-avl-cmpfun tree) @@ -470,7 +470,7 @@ Return DATA." data) data) -(defun avltree-delete (tree data) +(defun avl-tree-delete (tree data) "From the avl tree TREE, delete DATA. Return the element in TREE which matched DATA, nil if no element matched." (elib-avl-do-delete (elib-avl-cmpfun tree) @@ -478,9 +478,9 @@ Return the element in TREE which matched DATA, nil if no element matched." 0 data)) -(defun avltree-member (tree data) +(defun avl-tree-member (tree data) "Return the element in the avl tree TREE which matches DATA. -Matching uses the compare function previously specified in `avltree-create' +Matching uses the compare function previously specified in `avl-tree-create' when TREE was created. If there is no such element in the tree, the value is nil." @@ -501,7 +501,7 @@ If there is no such element in the tree, the value is nil." (elib-node-data node) nil))) -(defun avltree-map (__map-function__ tree) +(defun avl-tree-map (__map-function__ tree) "Apply MAP-FUNCTION to all elements in the avl tree TREE." (elib-avl-mapc (function (lambda (node) @@ -510,7 +510,7 @@ If there is no such element in the tree, the value is nil." (elib-node-data node))))) (elib-avl-root tree))) -(defun avltree-first (tree) +(defun avl-tree-first (tree) "Return the first element in TREE, or nil if TREE is empty." (let ((node (elib-avl-root tree))) (if node @@ -520,7 +520,7 @@ If there is no such element in the tree, the value is nil." (elib-node-data node)) nil))) -(defun avltree-last (tree) +(defun avl-tree-last (tree) "Return the last element in TREE, or nil if TREE is empty." (let ((node (elib-avl-root tree))) (if node @@ -530,15 +530,15 @@ If there is no such element in the tree, the value is nil." (elib-node-data node)) nil))) -(defun avltree-copy (tree) +(defun avl-tree-copy (tree) "Return a copy of the avl tree TREE." - (let ((new-tree (avltree-create + (let ((new-tree (avl-tree-create (elib-avl-cmpfun tree)))) (elib-node-set-left (elib-avl-dummyroot new-tree) (elib-avl-do-copy (elib-avl-root tree))) new-tree)) -(defun avltree-flatten (tree) +(defun avl-tree-flatten (tree) "Return a sorted list containing all elements of TREE." (nreverse (let ((treelist nil)) @@ -548,7 +548,7 @@ If there is no such element in the tree, the value is nil." (elib-avl-root tree)) treelist))) -(defun avltree-size (tree) +(defun avl-tree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) (elib-avl-mapc (function (lambda (data) @@ -557,11 +557,11 @@ If there is no such element in the tree, the value is nil." (elib-avl-root tree)) treesize)) -(defun avltree-clear (tree) +(defun avl-tree-clear (tree) "Clear the avl tree TREE." (elib-node-set-left (elib-avl-dummyroot tree) nil)) (provide 'avl-tree) ;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9 -;;; avltree.el ends here +;;; avl-tree.el ends here -- cgit v1.2.3 From 923135482e88d3a9296270856e6d9f5e41dd00f8 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:00:45 +0000 Subject: Reduce nesting: Use modern backquote syntax. --- lisp/emacs-lisp/avl-tree.el | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 58708f77a14..86e8c75d6b2 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -56,38 +56,38 @@ (defmacro elib-node-create (left right data) ;; Create a tree node from LEFT, RIGHT and DATA. - (` (vector (, left) (, right) (, data)))) + `(vector ,left ,right ,data)) (defmacro elib-node-left (node) ;; Return the left pointer of NODE. - (` (aref (, node) 0))) + `(aref ,node 0)) (defmacro elib-node-right (node) ;; Return the right pointer of NODE. - (` (aref (, node) 1))) + `(aref ,node 1)) (defmacro elib-node-data (node) ;; Return the data of NODE. - (` (aref (, node) 2))) + `(aref ,node 2)) (defmacro elib-node-set-left (node newleft) ;; Set the left pointer of NODE to NEWLEFT. - (` (aset (, node) 0 (, newleft)))) + `(aset ,node 0 ,newleft)) (defmacro elib-node-set-right (node newright) ;; Set the right pointer of NODE to NEWRIGHT. - (` (aset (, node) 1 (, newright)))) + `(aset ,node 1 ,newright)) (defmacro elib-node-set-data (node newdata) ;; Set the data of NODE to NEWDATA. - (` (aset (, node) 2 (, newdata)))) + `(aset ,node 2 ,newdata)) (defmacro elib-node-branch (node branch) ;; Get value of a branch of a node. ;; ;; NODE is the node, and BRANCH is the branch. ;; 0 for left pointer, 1 for right pointer and 2 for the data." - (` (aref (, node) (, branch)))) + `(aref ,node ,branch)) (defmacro elib-node-set-branch (node branch newval) ;; Set value of a branch of a node. @@ -95,22 +95,22 @@ ;; NODE is the node, and BRANCH is the branch. ;; 0 for left pointer, 1 for the right pointer and 2 for the data. ;; NEWVAL is new value of the branch." - (` (aset (, node) (, branch) (, newval)))) + `(aset ,node ,branch ,newval)) ;;; ================================================================ ;;; Functions and macros handling an AVL tree node. (defmacro elib-avl-node-create (left right data balance) ;; Create and return an avl-tree node. - (` (vector (, left) (, right) (, data) (, balance)))) + `(vector ,left ,right ,data ,balance)) (defmacro elib-avl-node-balance (node) ;; Return the balance field of a node. - (` (aref (, node) 3))) + `(aref ,node 3)) (defmacro elib-avl-node-set-balance (node newbal) ;; Set the balance field of a node. - (` (aset (, node) 3 (, newbal)))) + `(aset ,node 3 ,newbal)) ;;; ================================================================ @@ -122,15 +122,15 @@ (defmacro elib-avl-root (tree) ;; Return the root node for an avl-tree. INTERNAL USE ONLY. - (` (elib-node-left (car (cdr (, tree)))))) + `(elib-node-left (car (cdr ,tree)))) (defmacro elib-avl-dummyroot (tree) ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. - (` (car (cdr (, tree))))) + `(car (cdr ,tree))) (defmacro elib-avl-cmpfun (tree) ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. - (` (cdr (cdr (, tree))))) + `(cdr (cdr ,tree))) ;; ---------------------------------------------------------------- ;; Deleting data -- cgit v1.2.3 From 329dfe6ae7cb3813599290da97f84ee68340e20f Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:05:22 +0000 Subject: (elib-node-create): Delete unused macro. --- lisp/emacs-lisp/avl-tree.el | 4 ---- 1 file changed, 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 86e8c75d6b2..f5d6abc2226 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -54,10 +54,6 @@ ;;; Code: -(defmacro elib-node-create (left right data) - ;; Create a tree node from LEFT, RIGHT and DATA. - `(vector ,left ,right ,data)) - (defmacro elib-node-left (node) ;; Return the left pointer of NODE. `(aref ,node 0)) -- cgit v1.2.3 From dfd4af17e447929c26534bc232333eec7b74a6b4 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:11:12 +0000 Subject: Do s/elib-avl-node/avl-tree-node/g. Resulting changed macro names: avl-tree-node-create, avl-tree-node-balance, avl-tree-node-set-balance. --- lisp/emacs-lisp/avl-tree.el | 122 ++++++++++++++++++++++---------------------- 1 file changed, 61 insertions(+), 61 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index f5d6abc2226..a86fdc60f57 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -96,15 +96,15 @@ ;;; ================================================================ ;;; Functions and macros handling an AVL tree node. -(defmacro elib-avl-node-create (left right data balance) +(defmacro avl-tree-node-create (left right data balance) ;; Create and return an avl-tree node. `(vector ,left ,right ,data ,balance)) -(defmacro elib-avl-node-balance (node) +(defmacro avl-tree-node-balance (node) ;; Return the balance field of a node. `(aref ,node 3)) -(defmacro elib-avl-node-set-balance (node newbal) +(defmacro avl-tree-node-set-balance (node newbal) ;; Set the balance field of a node. `(aset ,node 3 ,newbal)) @@ -140,18 +140,18 @@ b2 result) (cond - ((< (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br 0) + ((< (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) t) - ((= (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br +1) + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br +1) nil) (t ;; Rebalance. (setq p1 (elib-node-right br) - b1 (elib-avl-node-balance p1)) + b1 (avl-tree-node-balance p1)) (if (>= b1 0) ;; Single RR rotation. (progn @@ -159,30 +159,30 @@ (elib-node-set-left p1 br) (if (= 0 b1) (progn - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance p1 -1) + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance p1 -1) (setq result nil)) - (elib-avl-node-set-balance br 0) - (elib-avl-node-set-balance p1 0) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-balance p1 0) (setq result t)) (elib-node-set-branch node branch p1) result) ;; Double RL rotation. (setq p2 (elib-node-left p1) - b2 (elib-avl-node-balance p2)) + b2 (avl-tree-node-balance p2)) (elib-node-set-left p1 (elib-node-right p2)) (elib-node-set-right p2 p1) (elib-node-set-right br (elib-node-left p2)) (elib-node-set-left p2 br) (if (> b2 0) - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance br 0)) + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance br 0)) (if (< b2 0) - (elib-avl-node-set-balance p1 +1) - (elib-avl-node-set-balance p1 0)) + (avl-tree-node-set-balance p1 +1) + (avl-tree-node-set-balance p1 0)) (elib-node-set-branch node branch p2) - (elib-avl-node-set-balance p2 0) + (avl-tree-node-set-balance p2 0) t))))) (defun elib-avl-del-balance2 (node branch) @@ -193,18 +193,18 @@ b2 result) (cond - ((> (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br 0) + ((> (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) t) - ((= (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br -1) + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br -1) nil) (t ;; Rebalance. (setq p1 (elib-node-left br) - b1 (elib-avl-node-balance p1)) + b1 (avl-tree-node-balance p1)) (if (<= b1 0) ;; Single LL rotation. (progn @@ -212,30 +212,30 @@ (elib-node-set-right p1 br) (if (= 0 b1) (progn - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance p1 +1) + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance p1 +1) (setq result nil)) - (elib-avl-node-set-balance br 0) - (elib-avl-node-set-balance p1 0) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-balance p1 0) (setq result t)) (elib-node-set-branch node branch p1) result) ;; Double LR rotation. (setq p2 (elib-node-right p1) - b2 (elib-avl-node-balance p2)) + b2 (avl-tree-node-balance p2)) (elib-node-set-right p1 (elib-node-left p2)) (elib-node-set-left p2 p1) (elib-node-set-left br (elib-node-right p2)) (elib-node-set-right p2 br) (if (< b2 0) - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance br 0)) + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance br 0)) (if (> b2 0) - (elib-avl-node-set-balance p1 -1) - (elib-avl-node-set-balance p1 0)) + (avl-tree-node-set-balance p1 -1) + (avl-tree-node-set-balance p1 0)) (elib-node-set-branch node branch p2) - (elib-avl-node-set-balance p2 0) + (avl-tree-node-set-balance p2 0) t))))) (defun elib-avl-do-del-internal (node branch q) @@ -290,40 +290,40 @@ b2 result) (cond - ((< (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br 0) + ((< (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) nil) - ((= (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br +1) + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br +1) t) (t ;; Tree has grown => Rebalance. (setq p1 (elib-node-right br)) - (if (> (elib-avl-node-balance p1) 0) + (if (> (avl-tree-node-balance p1) 0) ;; Single RR rotation. (progn (elib-node-set-right br (elib-node-left p1)) (elib-node-set-left p1 br) - (elib-avl-node-set-balance br 0) + (avl-tree-node-set-balance br 0) (elib-node-set-branch node branch p1)) ;; Double RL rotation. (setq p2 (elib-node-left p1) - b2 (elib-avl-node-balance p2)) + b2 (avl-tree-node-balance p2)) (elib-node-set-left p1 (elib-node-right p2)) (elib-node-set-right p2 p1) (elib-node-set-right br (elib-node-left p2)) (elib-node-set-left p2 br) (if (> b2 0) - (elib-avl-node-set-balance br -1) - (elib-avl-node-set-balance br 0)) + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance br 0)) (if (< b2 0) - (elib-avl-node-set-balance p1 +1) - (elib-avl-node-set-balance p1 0)) + (avl-tree-node-set-balance p1 +1) + (avl-tree-node-set-balance p1 0)) (elib-node-set-branch node branch p2)) - (elib-avl-node-set-balance (elib-node-branch node branch) 0) + (avl-tree-node-set-balance (elib-node-branch node branch) 0) nil)))) (defun elib-avl-enter-balance2 (node branch) @@ -333,40 +333,40 @@ p2 b2) (cond - ((> (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br 0) + ((> (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) nil) - ((= (elib-avl-node-balance br) 0) - (elib-avl-node-set-balance br -1) + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br -1) t) (t ;; Balance was -1 => Rebalance. (setq p1 (elib-node-left br)) - (if (< (elib-avl-node-balance p1) 0) + (if (< (avl-tree-node-balance p1) 0) ;; Single LL rotation. (progn (elib-node-set-left br (elib-node-right p1)) (elib-node-set-right p1 br) - (elib-avl-node-set-balance br 0) + (avl-tree-node-set-balance br 0) (elib-node-set-branch node branch p1)) ;; Double LR rotation. (setq p2 (elib-node-right p1) - b2 (elib-avl-node-balance p2)) + b2 (avl-tree-node-balance p2)) (elib-node-set-right p1 (elib-node-left p2)) (elib-node-set-left p2 p1) (elib-node-set-left br (elib-node-right p2)) (elib-node-set-right p2 br) (if (< b2 0) - (elib-avl-node-set-balance br +1) - (elib-avl-node-set-balance br 0)) + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance br 0)) (if (> b2 0) - (elib-avl-node-set-balance p1 -1) - (elib-avl-node-set-balance p1 0)) + (avl-tree-node-set-balance p1 -1) + (avl-tree-node-set-balance p1 0)) (elib-node-set-branch node branch p2)) - (elib-avl-node-set-balance (elib-node-branch node branch) 0) + (avl-tree-node-set-balance (elib-node-branch node branch) 0) nil)))) (defun elib-avl-do-enter (cmpfun root branch data) @@ -376,7 +376,7 @@ ((null br) ;; Data not in tree, insert it. (elib-node-set-branch root branch - (elib-avl-node-create nil nil data 0)) + (avl-tree-node-create nil nil data 0)) t) ((funcall cmpfun data (elib-node-data br)) @@ -428,10 +428,10 @@ ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil - (elib-avl-node-create (elib-avl-do-copy (elib-node-left root)) + (avl-tree-node-create (elib-avl-do-copy (elib-node-left root)) (elib-avl-do-copy (elib-node-right root)) (elib-node-data root) - (elib-avl-node-balance root)))) + (avl-tree-node-balance root)))) ;;; ================================================================ @@ -442,7 +442,7 @@ COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise." (cons 'AVL-TREE - (cons (elib-avl-node-create nil nil nil 0) + (cons (avl-tree-node-create nil nil nil 0) compare-function))) (defun avl-tree-p (obj) -- cgit v1.2.3 From 5afb301bee960583ddd66044367ac08155ff9be8 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:22:57 +0000 Subject: Do s/elib-avl-/avl-tree-/g. Resulting changed macro and function names: avl-tree-root, avl-tree-dummyroot, avl-tree-cmpfun, avl-tree-del-balance1, avl-tree-do-del-internal, avl-tree-del-balance2, avl-tree-do-delete, avl-tree-enter-balance1, avl-tree-enter-balance2, avl-tree-do-enter, avl-tree-mapc, avl-tree-do-copy. --- lisp/emacs-lisp/avl-tree.el | 96 ++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 50 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index a86fdc60f57..63e88ac21f9 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -112,26 +112,22 @@ ;;; ================================================================ ;;; Internal functions for use in the AVL tree package -;;; -;;; The functions and macros in this section all start with `elib-avl-'. -;;; - -(defmacro elib-avl-root (tree) +(defmacro avl-tree-root (tree) ;; Return the root node for an avl-tree. INTERNAL USE ONLY. `(elib-node-left (car (cdr ,tree)))) -(defmacro elib-avl-dummyroot (tree) +(defmacro avl-tree-dummyroot (tree) ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. `(car (cdr ,tree))) -(defmacro elib-avl-cmpfun (tree) +(defmacro avl-tree-cmpfun (tree) ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. `(cdr (cdr ,tree))) ;; ---------------------------------------------------------------- ;; Deleting data -(defun elib-avl-del-balance1 (node branch) +(defun avl-tree-del-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has shrunk. (let* ((br (elib-node-branch node branch)) p1 @@ -185,7 +181,7 @@ (avl-tree-node-set-balance p2 0) t))))) -(defun elib-avl-del-balance2 (node branch) +(defun avl-tree-del-balance2 (node branch) (let* ((br (elib-node-branch node branch)) p1 b1 @@ -238,18 +234,18 @@ (avl-tree-node-set-balance p2 0) t))))) -(defun elib-avl-do-del-internal (node branch q) +(defun avl-tree-do-del-internal (node branch q) (let* ((br (elib-node-branch node branch))) (if (elib-node-right br) - (if (elib-avl-do-del-internal br +1 q) - (elib-avl-del-balance2 node branch)) + (if (avl-tree-do-del-internal br +1 q) + (avl-tree-del-balance2 node branch)) (elib-node-set-data q (elib-node-data br)) (elib-node-set-branch node branch (elib-node-left br)) t))) -(defun elib-avl-do-delete (cmpfun root branch data) +(defun avl-tree-do-delete (cmpfun root branch data) ;; Return t if the height of the tree has shrunk. (let* ((br (elib-node-branch root branch))) (cond @@ -257,12 +253,12 @@ nil) ((funcall cmpfun data (elib-node-data br)) - (if (elib-avl-do-delete cmpfun br 0 data) - (elib-avl-del-balance1 root branch))) + (if (avl-tree-do-delete cmpfun br 0 data) + (avl-tree-del-balance1 root branch))) ((funcall cmpfun (elib-node-data br) data) - (if (elib-avl-do-delete cmpfun br 1 data) - (elib-avl-del-balance2 root branch))) + (if (avl-tree-do-delete cmpfun br 1 data) + (avl-tree-del-balance2 root branch))) (t ;; Found it. Let's delete it. @@ -276,13 +272,13 @@ t) (t - (if (elib-avl-do-del-internal br 0 br) - (elib-avl-del-balance1 root branch)))))))) + (if (avl-tree-do-del-internal br 0 br) + (avl-tree-del-balance1 root branch)))))))) ;; ---------------------------------------------------------------- ;; Entering data -(defun elib-avl-enter-balance1 (node branch) +(defun avl-tree-enter-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has grown. (let* ((br (elib-node-branch node branch)) p1 @@ -326,7 +322,7 @@ (avl-tree-node-set-balance (elib-node-branch node branch) 0) nil)))) -(defun elib-avl-enter-balance2 (node branch) +(defun avl-tree-enter-balance2 (node branch) ;; Return t if the tree has grown. (let* ((br (elib-node-branch node branch)) p1 @@ -369,7 +365,7 @@ (avl-tree-node-set-balance (elib-node-branch node branch) 0) nil)))) -(defun elib-avl-do-enter (cmpfun root branch data) +(defun avl-tree-do-enter (cmpfun root branch data) ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. (let ((br (elib-node-branch root branch))) (cond @@ -380,16 +376,16 @@ t) ((funcall cmpfun data (elib-node-data br)) - (and (elib-avl-do-enter cmpfun + (and (avl-tree-do-enter cmpfun br 0 data) - (elib-avl-enter-balance2 root branch))) + (avl-tree-enter-balance2 root branch))) ((funcall cmpfun (elib-node-data br) data) - (and (elib-avl-do-enter cmpfun + (and (avl-tree-do-enter cmpfun br 1 data) - (elib-avl-enter-balance1 root branch))) + (avl-tree-enter-balance1 root branch))) (t (elib-node-set-data br data) @@ -397,7 +393,7 @@ ;; ---------------------------------------------------------------- -(defun elib-avl-mapc (map-function root) +(defun avl-tree-mapc (map-function root) ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. ;; The function is applied in-order. ;; @@ -423,13 +419,13 @@ (setq node (pop stack) go-left nil)))))) -(defun elib-avl-do-copy (root) +(defun avl-tree-do-copy (root) ;; Copy the tree with ROOT as root. ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil - (avl-tree-node-create (elib-avl-do-copy (elib-node-left root)) - (elib-avl-do-copy (elib-node-right root)) + (avl-tree-node-create (avl-tree-do-copy (elib-node-left root)) + (avl-tree-do-copy (elib-node-right root)) (elib-node-data root) (avl-tree-node-balance root)))) @@ -451,17 +447,17 @@ and returns non-nil if A is less than B, and nil otherwise." (defun avl-tree-compare-function (tree) "Return the comparision function for the avl tree TREE." - (elib-avl-cmpfun tree)) + (avl-tree-cmpfun tree)) (defun avl-tree-empty (tree) "Return t if TREE is emtpy, otherwise return nil." - (null (elib-avl-root tree))) + (null (avl-tree-root tree))) (defun avl-tree-enter (tree data) "In the avl tree TREE insert DATA. Return DATA." - (elib-avl-do-enter (elib-avl-cmpfun tree) - (elib-avl-dummyroot tree) + (avl-tree-do-enter (avl-tree-cmpfun tree) + (avl-tree-dummyroot tree) 0 data) data) @@ -469,8 +465,8 @@ Return DATA." (defun avl-tree-delete (tree data) "From the avl tree TREE, delete DATA. Return the element in TREE which matched DATA, nil if no element matched." - (elib-avl-do-delete (elib-avl-cmpfun tree) - (elib-avl-dummyroot tree) + (avl-tree-do-delete (avl-tree-cmpfun tree) + (avl-tree-dummyroot tree) 0 data)) @@ -480,8 +476,8 @@ Matching uses the compare function previously specified in `avl-tree-create' when TREE was created. If there is no such element in the tree, the value is nil." - (let ((node (elib-avl-root tree)) - (compare-function (elib-avl-cmpfun tree)) + (let ((node (avl-tree-root tree)) + (compare-function (avl-tree-cmpfun tree)) found) (while (and node (not found)) @@ -499,16 +495,16 @@ If there is no such element in the tree, the value is nil." (defun avl-tree-map (__map-function__ tree) "Apply MAP-FUNCTION to all elements in the avl tree TREE." - (elib-avl-mapc + (avl-tree-mapc (function (lambda (node) (elib-node-set-data node (funcall __map-function__ (elib-node-data node))))) - (elib-avl-root tree))) + (avl-tree-root tree))) (defun avl-tree-first (tree) "Return the first element in TREE, or nil if TREE is empty." - (let ((node (elib-avl-root tree))) + (let ((node (avl-tree-root tree))) (if node (progn (while (elib-node-left node) @@ -518,7 +514,7 @@ If there is no such element in the tree, the value is nil." (defun avl-tree-last (tree) "Return the last element in TREE, or nil if TREE is empty." - (let ((node (elib-avl-root tree))) + (let ((node (avl-tree-root tree))) (if node (progn (while (elib-node-right node) @@ -529,33 +525,33 @@ If there is no such element in the tree, the value is nil." (defun avl-tree-copy (tree) "Return a copy of the avl tree TREE." (let ((new-tree (avl-tree-create - (elib-avl-cmpfun tree)))) - (elib-node-set-left (elib-avl-dummyroot new-tree) - (elib-avl-do-copy (elib-avl-root tree))) + (avl-tree-cmpfun tree)))) + (elib-node-set-left (avl-tree-dummyroot new-tree) + (avl-tree-do-copy (avl-tree-root tree))) new-tree)) (defun avl-tree-flatten (tree) "Return a sorted list containing all elements of TREE." (nreverse (let ((treelist nil)) - (elib-avl-mapc (function (lambda (node) + (avl-tree-mapc (function (lambda (node) (setq treelist (cons (elib-node-data node) treelist)))) - (elib-avl-root tree)) + (avl-tree-root tree)) treelist))) (defun avl-tree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) - (elib-avl-mapc (function (lambda (data) + (avl-tree-mapc (function (lambda (data) (setq treesize (1+ treesize)) data)) - (elib-avl-root tree)) + (avl-tree-root tree)) treesize)) (defun avl-tree-clear (tree) "Clear the avl tree TREE." - (elib-node-set-left (elib-avl-dummyroot tree) nil)) + (elib-node-set-left (avl-tree-dummyroot tree) nil)) (provide 'avl-tree) -- cgit v1.2.3 From bdf0a828423d27d8a0ea956da4eda1754631dc3b Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:31:23 +0000 Subject: Do s/elib-node-/avl-tree-node-/g. Resulting changed macro names: avl-tree-node-left, avl-tree-node-right, avl-tree-node-data, avl-tree-node-set-left, avl-tree-node-set-right, avl-tree-node-set-data, avl-tree-node-branch, avl-tree-node-set-branch. --- lisp/emacs-lisp/avl-tree.el | 190 ++++++++++++++++++++++---------------------- 1 file changed, 95 insertions(+), 95 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 63e88ac21f9..0e37e718250 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -54,38 +54,38 @@ ;;; Code: -(defmacro elib-node-left (node) +(defmacro avl-tree-node-left (node) ;; Return the left pointer of NODE. `(aref ,node 0)) -(defmacro elib-node-right (node) +(defmacro avl-tree-node-right (node) ;; Return the right pointer of NODE. `(aref ,node 1)) -(defmacro elib-node-data (node) +(defmacro avl-tree-node-data (node) ;; Return the data of NODE. `(aref ,node 2)) -(defmacro elib-node-set-left (node newleft) +(defmacro avl-tree-node-set-left (node newleft) ;; Set the left pointer of NODE to NEWLEFT. `(aset ,node 0 ,newleft)) -(defmacro elib-node-set-right (node newright) +(defmacro avl-tree-node-set-right (node newright) ;; Set the right pointer of NODE to NEWRIGHT. `(aset ,node 1 ,newright)) -(defmacro elib-node-set-data (node newdata) +(defmacro avl-tree-node-set-data (node newdata) ;; Set the data of NODE to NEWDATA. `(aset ,node 2 ,newdata)) -(defmacro elib-node-branch (node branch) +(defmacro avl-tree-node-branch (node branch) ;; Get value of a branch of a node. ;; ;; NODE is the node, and BRANCH is the branch. ;; 0 for left pointer, 1 for right pointer and 2 for the data." `(aref ,node ,branch)) -(defmacro elib-node-set-branch (node branch newval) +(defmacro avl-tree-node-set-branch (node branch newval) ;; Set value of a branch of a node. ;; ;; NODE is the node, and BRANCH is the branch. @@ -114,7 +114,7 @@ (defmacro avl-tree-root (tree) ;; Return the root node for an avl-tree. INTERNAL USE ONLY. - `(elib-node-left (car (cdr ,tree)))) + `(avl-tree-node-left (car (cdr ,tree)))) (defmacro avl-tree-dummyroot (tree) ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. @@ -129,7 +129,7 @@ (defun avl-tree-del-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has shrunk. - (let* ((br (elib-node-branch node branch)) + (let* ((br (avl-tree-node-branch node branch)) p1 b1 p2 @@ -146,13 +146,13 @@ (t ;; Rebalance. - (setq p1 (elib-node-right br) + (setq p1 (avl-tree-node-right br) b1 (avl-tree-node-balance p1)) (if (>= b1 0) ;; Single RR rotation. (progn - (elib-node-set-right br (elib-node-left p1)) - (elib-node-set-left p1 br) + (avl-tree-node-set-right br (avl-tree-node-left p1)) + (avl-tree-node-set-left p1 br) (if (= 0 b1) (progn (avl-tree-node-set-balance br +1) @@ -161,28 +161,28 @@ (avl-tree-node-set-balance br 0) (avl-tree-node-set-balance p1 0) (setq result t)) - (elib-node-set-branch node branch p1) + (avl-tree-node-set-branch node branch p1) result) ;; Double RL rotation. - (setq p2 (elib-node-left p1) + (setq p2 (avl-tree-node-left p1) b2 (avl-tree-node-balance p2)) - (elib-node-set-left p1 (elib-node-right p2)) - (elib-node-set-right p2 p1) - (elib-node-set-right br (elib-node-left p2)) - (elib-node-set-left p2 br) + (avl-tree-node-set-left p1 (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 p1) + (avl-tree-node-set-right br (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 br) (if (> b2 0) (avl-tree-node-set-balance br -1) (avl-tree-node-set-balance br 0)) (if (< b2 0) (avl-tree-node-set-balance p1 +1) (avl-tree-node-set-balance p1 0)) - (elib-node-set-branch node branch p2) + (avl-tree-node-set-branch node branch p2) (avl-tree-node-set-balance p2 0) t))))) (defun avl-tree-del-balance2 (node branch) - (let* ((br (elib-node-branch node branch)) + (let* ((br (avl-tree-node-branch node branch)) p1 b1 p2 @@ -199,13 +199,13 @@ (t ;; Rebalance. - (setq p1 (elib-node-left br) + (setq p1 (avl-tree-node-left br) b1 (avl-tree-node-balance p1)) (if (<= b1 0) ;; Single LL rotation. (progn - (elib-node-set-left br (elib-node-right p1)) - (elib-node-set-right p1 br) + (avl-tree-node-set-left br (avl-tree-node-right p1)) + (avl-tree-node-set-right p1 br) (if (= 0 b1) (progn (avl-tree-node-set-balance br -1) @@ -214,61 +214,61 @@ (avl-tree-node-set-balance br 0) (avl-tree-node-set-balance p1 0) (setq result t)) - (elib-node-set-branch node branch p1) + (avl-tree-node-set-branch node branch p1) result) ;; Double LR rotation. - (setq p2 (elib-node-right p1) + (setq p2 (avl-tree-node-right p1) b2 (avl-tree-node-balance p2)) - (elib-node-set-right p1 (elib-node-left p2)) - (elib-node-set-left p2 p1) - (elib-node-set-left br (elib-node-right p2)) - (elib-node-set-right p2 br) + (avl-tree-node-set-right p1 (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 p1) + (avl-tree-node-set-left br (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 br) (if (< b2 0) (avl-tree-node-set-balance br +1) (avl-tree-node-set-balance br 0)) (if (> b2 0) (avl-tree-node-set-balance p1 -1) (avl-tree-node-set-balance p1 0)) - (elib-node-set-branch node branch p2) + (avl-tree-node-set-branch node branch p2) (avl-tree-node-set-balance p2 0) t))))) (defun avl-tree-do-del-internal (node branch q) - (let* ((br (elib-node-branch node branch))) - (if (elib-node-right br) + (let* ((br (avl-tree-node-branch node branch))) + (if (avl-tree-node-right br) (if (avl-tree-do-del-internal br +1 q) (avl-tree-del-balance2 node branch)) - (elib-node-set-data q (elib-node-data br)) - (elib-node-set-branch node branch - (elib-node-left br)) + (avl-tree-node-set-data q (avl-tree-node-data br)) + (avl-tree-node-set-branch node branch + (avl-tree-node-left br)) t))) (defun avl-tree-do-delete (cmpfun root branch data) ;; Return t if the height of the tree has shrunk. - (let* ((br (elib-node-branch root branch))) + (let* ((br (avl-tree-node-branch root branch))) (cond ((null br) nil) - ((funcall cmpfun data (elib-node-data br)) + ((funcall cmpfun data (avl-tree-node-data br)) (if (avl-tree-do-delete cmpfun br 0 data) (avl-tree-del-balance1 root branch))) - ((funcall cmpfun (elib-node-data br) data) + ((funcall cmpfun (avl-tree-node-data br) data) (if (avl-tree-do-delete cmpfun br 1 data) (avl-tree-del-balance2 root branch))) (t ;; Found it. Let's delete it. (cond - ((null (elib-node-right br)) - (elib-node-set-branch root branch (elib-node-left br)) + ((null (avl-tree-node-right br)) + (avl-tree-node-set-branch root branch (avl-tree-node-left br)) t) - ((null (elib-node-left br)) - (elib-node-set-branch root branch (elib-node-right br)) + ((null (avl-tree-node-left br)) + (avl-tree-node-set-branch root branch (avl-tree-node-right br)) t) (t @@ -280,7 +280,7 @@ (defun avl-tree-enter-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has grown. - (let* ((br (elib-node-branch node branch)) + (let* ((br (avl-tree-node-branch node branch)) p1 p2 b2 @@ -296,35 +296,35 @@ (t ;; Tree has grown => Rebalance. - (setq p1 (elib-node-right br)) + (setq p1 (avl-tree-node-right br)) (if (> (avl-tree-node-balance p1) 0) ;; Single RR rotation. (progn - (elib-node-set-right br (elib-node-left p1)) - (elib-node-set-left p1 br) + (avl-tree-node-set-right br (avl-tree-node-left p1)) + (avl-tree-node-set-left p1 br) (avl-tree-node-set-balance br 0) - (elib-node-set-branch node branch p1)) + (avl-tree-node-set-branch node branch p1)) ;; Double RL rotation. - (setq p2 (elib-node-left p1) + (setq p2 (avl-tree-node-left p1) b2 (avl-tree-node-balance p2)) - (elib-node-set-left p1 (elib-node-right p2)) - (elib-node-set-right p2 p1) - (elib-node-set-right br (elib-node-left p2)) - (elib-node-set-left p2 br) + (avl-tree-node-set-left p1 (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 p1) + (avl-tree-node-set-right br (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 br) (if (> b2 0) (avl-tree-node-set-balance br -1) (avl-tree-node-set-balance br 0)) (if (< b2 0) (avl-tree-node-set-balance p1 +1) (avl-tree-node-set-balance p1 0)) - (elib-node-set-branch node branch p2)) - (avl-tree-node-set-balance (elib-node-branch node branch) 0) + (avl-tree-node-set-branch node branch p2)) + (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) nil)))) (defun avl-tree-enter-balance2 (node branch) ;; Return t if the tree has grown. - (let* ((br (elib-node-branch node branch)) + (let* ((br (avl-tree-node-branch node branch)) p1 p2 b2) @@ -339,56 +339,56 @@ (t ;; Balance was -1 => Rebalance. - (setq p1 (elib-node-left br)) + (setq p1 (avl-tree-node-left br)) (if (< (avl-tree-node-balance p1) 0) ;; Single LL rotation. (progn - (elib-node-set-left br (elib-node-right p1)) - (elib-node-set-right p1 br) + (avl-tree-node-set-left br (avl-tree-node-right p1)) + (avl-tree-node-set-right p1 br) (avl-tree-node-set-balance br 0) - (elib-node-set-branch node branch p1)) + (avl-tree-node-set-branch node branch p1)) ;; Double LR rotation. - (setq p2 (elib-node-right p1) + (setq p2 (avl-tree-node-right p1) b2 (avl-tree-node-balance p2)) - (elib-node-set-right p1 (elib-node-left p2)) - (elib-node-set-left p2 p1) - (elib-node-set-left br (elib-node-right p2)) - (elib-node-set-right p2 br) + (avl-tree-node-set-right p1 (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 p1) + (avl-tree-node-set-left br (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 br) (if (< b2 0) (avl-tree-node-set-balance br +1) (avl-tree-node-set-balance br 0)) (if (> b2 0) (avl-tree-node-set-balance p1 -1) (avl-tree-node-set-balance p1 0)) - (elib-node-set-branch node branch p2)) - (avl-tree-node-set-balance (elib-node-branch node branch) 0) + (avl-tree-node-set-branch node branch p2)) + (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) nil)))) (defun avl-tree-do-enter (cmpfun root branch data) ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. - (let ((br (elib-node-branch root branch))) + (let ((br (avl-tree-node-branch root branch))) (cond ((null br) ;; Data not in tree, insert it. - (elib-node-set-branch root branch + (avl-tree-node-set-branch root branch (avl-tree-node-create nil nil data 0)) t) - ((funcall cmpfun data (elib-node-data br)) + ((funcall cmpfun data (avl-tree-node-data br)) (and (avl-tree-do-enter cmpfun br 0 data) (avl-tree-enter-balance2 root branch))) - ((funcall cmpfun (elib-node-data br) data) + ((funcall cmpfun (avl-tree-node-data br) data) (and (avl-tree-do-enter cmpfun br 1 data) (avl-tree-enter-balance1 root branch))) (t - (elib-node-set-data br data) + (avl-tree-node-set-data br data) nil)))) ;; ---------------------------------------------------------------- @@ -405,16 +405,16 @@ (push nil stack) (while node (if (and go-left - (elib-node-left node)) + (avl-tree-node-left node)) ;; Do the left subtree first. (progn (push node stack) - (setq node (elib-node-left node))) + (setq node (avl-tree-node-left node))) ;; Apply the function... (funcall map-function node) ;; and do the right subtree. - (if (elib-node-right node) - (setq node (elib-node-right node) + (if (avl-tree-node-right node) + (setq node (avl-tree-node-right node) go-left t) (setq node (pop stack) go-left nil)))))) @@ -424,9 +424,9 @@ ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil - (avl-tree-node-create (avl-tree-do-copy (elib-node-left root)) - (avl-tree-do-copy (elib-node-right root)) - (elib-node-data root) + (avl-tree-node-create (avl-tree-do-copy (avl-tree-node-left root)) + (avl-tree-do-copy (avl-tree-node-right root)) + (avl-tree-node-data root) (avl-tree-node-balance root)))) @@ -482,24 +482,24 @@ If there is no such element in the tree, the value is nil." (while (and node (not found)) (cond - ((funcall compare-function data (elib-node-data node)) - (setq node (elib-node-left node))) - ((funcall compare-function (elib-node-data node) data) - (setq node (elib-node-right node))) + ((funcall compare-function data (avl-tree-node-data node)) + (setq node (avl-tree-node-left node))) + ((funcall compare-function (avl-tree-node-data node) data) + (setq node (avl-tree-node-right node))) (t (setq found t)))) (if node - (elib-node-data node) + (avl-tree-node-data node) nil))) (defun avl-tree-map (__map-function__ tree) "Apply MAP-FUNCTION to all elements in the avl tree TREE." (avl-tree-mapc (function (lambda (node) - (elib-node-set-data node + (avl-tree-node-set-data node (funcall __map-function__ - (elib-node-data node))))) + (avl-tree-node-data node))))) (avl-tree-root tree))) (defun avl-tree-first (tree) @@ -507,9 +507,9 @@ If there is no such element in the tree, the value is nil." (let ((node (avl-tree-root tree))) (if node (progn - (while (elib-node-left node) - (setq node (elib-node-left node))) - (elib-node-data node)) + (while (avl-tree-node-left node) + (setq node (avl-tree-node-left node))) + (avl-tree-node-data node)) nil))) (defun avl-tree-last (tree) @@ -517,16 +517,16 @@ If there is no such element in the tree, the value is nil." (let ((node (avl-tree-root tree))) (if node (progn - (while (elib-node-right node) - (setq node (elib-node-right node))) - (elib-node-data node)) + (while (avl-tree-node-right node) + (setq node (avl-tree-node-right node))) + (avl-tree-node-data node)) nil))) (defun avl-tree-copy (tree) "Return a copy of the avl tree TREE." (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) - (elib-node-set-left (avl-tree-dummyroot new-tree) + (avl-tree-node-set-left (avl-tree-dummyroot new-tree) (avl-tree-do-copy (avl-tree-root tree))) new-tree)) @@ -535,7 +535,7 @@ If there is no such element in the tree, the value is nil." (nreverse (let ((treelist nil)) (avl-tree-mapc (function (lambda (node) - (setq treelist (cons (elib-node-data node) + (setq treelist (cons (avl-tree-node-data node) treelist)))) (avl-tree-root tree)) treelist))) @@ -551,7 +551,7 @@ If there is no such element in the tree, the value is nil." (defun avl-tree-clear (tree) "Clear the avl tree TREE." - (elib-node-set-left (avl-tree-dummyroot tree) nil)) + (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) (provide 'avl-tree) -- cgit v1.2.3 From 5fa11cc28db07e1ac0c06ad10fc45ed7caddb315 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:40:25 +0000 Subject: Move things around; munge whitespace, indentation; nfc. --- lisp/emacs-lisp/avl-tree.el | 89 ++++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 53 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 0e37e718250..7dd4d18da7c 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -54,6 +54,13 @@ ;;; Code: +;;; ================================================================ +;;; Functions and macros handling an AVL tree node. + +(defmacro avl-tree-node-create (left right data balance) + ;; Create and return an avl-tree node. + `(vector ,left ,right ,data ,balance)) + (defmacro avl-tree-node-left (node) ;; Return the left pointer of NODE. `(aref ,node 0)) @@ -93,13 +100,6 @@ ;; NEWVAL is new value of the branch." `(aset ,node ,branch ,newval)) -;;; ================================================================ -;;; Functions and macros handling an AVL tree node. - -(defmacro avl-tree-node-create (left right data balance) - ;; Create and return an avl-tree node. - `(vector ,left ,right ,data ,balance)) - (defmacro avl-tree-node-balance (node) ;; Return the balance field of a node. `(aref ,node 3)) @@ -130,11 +130,7 @@ (defun avl-tree-del-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has shrunk. (let* ((br (avl-tree-node-branch node branch)) - p1 - b1 - p2 - b2 - result) + p1 b1 p2 b2 result) (cond ((< (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -183,11 +179,7 @@ (defun avl-tree-del-balance2 (node branch) (let* ((br (avl-tree-node-branch node branch)) - p1 - b1 - p2 - b2 - result) + p1 b1 p2 b2 result) (cond ((> (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -235,14 +227,13 @@ t))))) (defun avl-tree-do-del-internal (node branch q) - (let* ((br (avl-tree-node-branch node branch))) (if (avl-tree-node-right br) (if (avl-tree-do-del-internal br +1 q) (avl-tree-del-balance2 node branch)) (avl-tree-node-set-data q (avl-tree-node-data br)) (avl-tree-node-set-branch node branch - (avl-tree-node-left br)) + (avl-tree-node-left br)) t))) (defun avl-tree-do-delete (cmpfun root branch data) @@ -281,10 +272,7 @@ (defun avl-tree-enter-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has grown. (let* ((br (avl-tree-node-branch node branch)) - p1 - p2 - b2 - result) + p1 p2 b2 result) (cond ((< (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -325,9 +313,7 @@ (defun avl-tree-enter-balance2 (node branch) ;; Return t if the tree has grown. (let* ((br (avl-tree-node-branch node branch)) - p1 - p2 - b2) + p1 p2 b2) (cond ((> (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -371,20 +357,16 @@ (cond ((null br) ;; Data not in tree, insert it. - (avl-tree-node-set-branch root branch - (avl-tree-node-create nil nil data 0)) + (avl-tree-node-set-branch + root branch (avl-tree-node-create nil nil data 0)) t) ((funcall cmpfun data (avl-tree-node-data br)) - (and (avl-tree-do-enter cmpfun - br - 0 data) + (and (avl-tree-do-enter cmpfun br 0 data) (avl-tree-enter-balance2 root branch))) ((funcall cmpfun (avl-tree-node-data br) data) - (and (avl-tree-do-enter cmpfun - br - 1 data) + (and (avl-tree-do-enter cmpfun br 1 data) (avl-tree-enter-balance1 root branch))) (t @@ -424,10 +406,11 @@ ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil - (avl-tree-node-create (avl-tree-do-copy (avl-tree-node-left root)) - (avl-tree-do-copy (avl-tree-node-right root)) - (avl-tree-node-data root) - (avl-tree-node-balance root)))) + (avl-tree-node-create + (avl-tree-do-copy (avl-tree-node-left root)) + (avl-tree-do-copy (avl-tree-node-right root)) + (avl-tree-node-data root) + (avl-tree-node-balance root)))) ;;; ================================================================ @@ -488,7 +471,6 @@ If there is no such element in the tree, the value is nil." (setq node (avl-tree-node-right node))) (t (setq found t)))) - (if node (avl-tree-node-data node) nil))) @@ -497,9 +479,9 @@ If there is no such element in the tree, the value is nil." "Apply MAP-FUNCTION to all elements in the avl tree TREE." (avl-tree-mapc (function (lambda (node) - (avl-tree-node-set-data node - (funcall __map-function__ - (avl-tree-node-data node))))) + (avl-tree-node-set-data + node (funcall __map-function__ + (avl-tree-node-data node))))) (avl-tree-root tree))) (defun avl-tree-first (tree) @@ -524,29 +506,30 @@ If there is no such element in the tree, the value is nil." (defun avl-tree-copy (tree) "Return a copy of the avl tree TREE." - (let ((new-tree (avl-tree-create - (avl-tree-cmpfun tree)))) + (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) (avl-tree-node-set-left (avl-tree-dummyroot new-tree) - (avl-tree-do-copy (avl-tree-root tree))) + (avl-tree-do-copy (avl-tree-root tree))) new-tree)) (defun avl-tree-flatten (tree) "Return a sorted list containing all elements of TREE." (nreverse (let ((treelist nil)) - (avl-tree-mapc (function (lambda (node) - (setq treelist (cons (avl-tree-node-data node) - treelist)))) - (avl-tree-root tree)) + (avl-tree-mapc + (function (lambda (node) + (setq treelist (cons (avl-tree-node-data node) + treelist)))) + (avl-tree-root tree)) treelist))) (defun avl-tree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) - (avl-tree-mapc (function (lambda (data) - (setq treesize (1+ treesize)) - data)) - (avl-tree-root tree)) + (avl-tree-mapc + (function (lambda (data) + (setq treesize (1+ treesize)) + data)) + (avl-tree-root tree)) treesize)) (defun avl-tree-clear (tree) -- cgit v1.2.3 From 8fa134424913ad16f2b95f1d1cb2992d3fd17059 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 02:49:40 +0000 Subject: (avl-tree-del-balance1, avl-tree-del-balance2) (avl-tree-do-del-internal, avl-tree-do-delete) (avl-tree-enter-balance1, avl-tree-enter-balance2): Use plain `let'. --- lisp/emacs-lisp/avl-tree.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 7dd4d18da7c..074f8e7c772 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -129,8 +129,8 @@ (defun avl-tree-del-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has shrunk. - (let* ((br (avl-tree-node-branch node branch)) - p1 b1 p2 b2 result) + (let ((br (avl-tree-node-branch node branch)) + p1 b1 p2 b2 result) (cond ((< (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -178,8 +178,8 @@ t))))) (defun avl-tree-del-balance2 (node branch) - (let* ((br (avl-tree-node-branch node branch)) - p1 b1 p2 b2 result) + (let ((br (avl-tree-node-branch node branch)) + p1 b1 p2 b2 result) (cond ((> (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -227,7 +227,7 @@ t))))) (defun avl-tree-do-del-internal (node branch q) - (let* ((br (avl-tree-node-branch node branch))) + (let ((br (avl-tree-node-branch node branch))) (if (avl-tree-node-right br) (if (avl-tree-do-del-internal br +1 q) (avl-tree-del-balance2 node branch)) @@ -238,7 +238,7 @@ (defun avl-tree-do-delete (cmpfun root branch data) ;; Return t if the height of the tree has shrunk. - (let* ((br (avl-tree-node-branch root branch))) + (let ((br (avl-tree-node-branch root branch))) (cond ((null br) nil) @@ -271,8 +271,8 @@ (defun avl-tree-enter-balance1 (node branch) ;; Rebalance a tree and return t if the height of the tree has grown. - (let* ((br (avl-tree-node-branch node branch)) - p1 p2 b2 result) + (let ((br (avl-tree-node-branch node branch)) + p1 p2 b2 result) (cond ((< (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) @@ -312,8 +312,8 @@ (defun avl-tree-enter-balance2 (node branch) ;; Return t if the tree has grown. - (let* ((br (avl-tree-node-branch node branch)) - p1 p2 b2) + (let ((br (avl-tree-node-branch node branch)) + p1 p2 b2) (cond ((> (avl-tree-node-balance br) 0) (avl-tree-node-set-balance br 0) -- cgit v1.2.3 From d385b030e7924a8ef5d7df63b25ce12e3fbd6311 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Mon, 27 Aug 2007 03:09:15 +0000 Subject: Commentary and docstring munging; nfc. --- lisp/emacs-lisp/avl-tree.el | 52 +++++++++++++++++++-------------------------- 1 file changed, 22 insertions(+), 30 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 074f8e7c772..ffac825acac 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -28,19 +28,6 @@ ;;; Commentary: -;; This file combines elib-node.el and avltree.el from Elib. -;; -;; * Comments from elib-node.el -;; A node is implemented as an array with three elements, using -;; (elt node 0) as the left pointer -;; (elt node 1) as the right pointer -;; (elt node 2) as the data -;; -;; Some types of trees, e.g. AVL trees, need bigger nodes, but -;; as long as the first three parts are the left pointer, the -;; right pointer and the data field, these macros can be used. -;; -;; * Comments from avltree.el ;; An AVL tree is a nearly-perfect balanced binary tree. A tree ;; consists of two cons cells, the first one holding the tag ;; 'AVL-TREE in the car cell, and the second one having the tree @@ -51,6 +38,10 @@ ;; sub-tree and one right sub-tree. Each node also has a balance ;; count, which is the difference in depth of the left and right ;; sub-trees. +;; +;; The "public" functions (prefixed with "avl-tree") are: +;; -create, -p, -compare-function, -empty, -enter, -delete, +;; -member, -map, -first, -last, -copy, -flatten, -size, -clear. ;;; Code: @@ -86,18 +77,18 @@ `(aset ,node 2 ,newdata)) (defmacro avl-tree-node-branch (node branch) - ;; Get value of a branch of a node. - ;; - ;; NODE is the node, and BRANCH is the branch. - ;; 0 for left pointer, 1 for right pointer and 2 for the data." + "Get value of a branch of a node. + +NODE is the node, and BRANCH is the branch. +0 for left pointer, 1 for right pointer and 2 for the data.\"" `(aref ,node ,branch)) (defmacro avl-tree-node-set-branch (node branch newval) - ;; Set value of a branch of a node. - ;; - ;; NODE is the node, and BRANCH is the branch. - ;; 0 for left pointer, 1 for the right pointer and 2 for the data. - ;; NEWVAL is new value of the branch." + "Set value of a branch of a node. + +NODE is the node, and BRANCH is the branch. +0 for left pointer, 1 for the right pointer and 2 for the data. +NEWVAL is new value of the branch.\"" `(aset ,node ,branch ,newval)) (defmacro avl-tree-node-balance (node) @@ -402,7 +393,7 @@ go-left nil)))))) (defun avl-tree-do-copy (root) - ;; Copy the tree with ROOT as root. + ;; Copy the avl tree with ROOT as root. ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil @@ -417,7 +408,7 @@ ;;; The public functions which operate on AVL trees. (defun avl-tree-create (compare-function) - "Create an empty avl tree. + "Create a new empty avl tree and return it. COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise." (cons 'AVL-TREE @@ -429,11 +420,11 @@ and returns non-nil if A is less than B, and nil otherwise." (eq (car-safe obj) 'AVL-TREE)) (defun avl-tree-compare-function (tree) - "Return the comparision function for the avl tree TREE." + "Return the comparison function for the avl tree TREE." (avl-tree-cmpfun tree)) (defun avl-tree-empty (tree) - "Return t if TREE is emtpy, otherwise return nil." + "Return t if avl tree TREE is emtpy, otherwise return nil." (null (avl-tree-root tree))) (defun avl-tree-enter (tree data) @@ -447,7 +438,8 @@ Return DATA." (defun avl-tree-delete (tree data) "From the avl tree TREE, delete DATA. -Return the element in TREE which matched DATA, nil if no element matched." +Return the element in TREE which matched DATA, +nil if no element matched." (avl-tree-do-delete (avl-tree-cmpfun tree) (avl-tree-dummyroot tree) 0 @@ -455,8 +447,8 @@ Return the element in TREE which matched DATA, nil if no element matched." (defun avl-tree-member (tree data) "Return the element in the avl tree TREE which matches DATA. -Matching uses the compare function previously specified in `avl-tree-create' -when TREE was created. +Matching uses the compare function previously specified in +`avl-tree-create' when TREE was created. If there is no such element in the tree, the value is nil." (let ((node (avl-tree-root tree)) @@ -476,7 +468,7 @@ If there is no such element in the tree, the value is nil." nil))) (defun avl-tree-map (__map-function__ tree) - "Apply MAP-FUNCTION to all elements in the avl tree TREE." + "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." (avl-tree-mapc (function (lambda (node) (avl-tree-node-set-data -- cgit v1.2.3