diff options
| author | Dave Love | 2000-01-05 16:51:08 +0000 |
|---|---|---|
| committer | Dave Love | 2000-01-05 16:51:08 +0000 |
| commit | 723dd32d78907fe2ba39dc1c2e86296952cfb5ec (patch) | |
| tree | 9b4749a3dbefb34c2ea742ecd4760e37b113c37c | |
| parent | c7f836c751befc88c4c2c230ce1fc4128fcfc893 (diff) | |
| download | emacs-723dd32d78907fe2ba39dc1c2e86296952cfb5ec.tar.gz emacs-723dd32d78907fe2ba39dc1c2e86296952cfb5ec.zip | |
(cl-make-hash-table): Use make-hash-table.
(cl-lucid-hash-tag): Delete.
(cl-hash-table-p): Correct test for native table.
(cl-hash-table-count): Use hash-table-count.
| -rw-r--r-- | lisp/emacs-lisp/cl-extra.el | 31 |
1 files changed, 6 insertions, 25 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index dc5c1c7bd9e..96636a9b6d2 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el | |||
| @@ -3,7 +3,6 @@ | |||
| 3 | ;; Copyright (C) 1993 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Dave Gillespie <daveg@synaptics.com> | 5 | ;; Author: Dave Gillespie <daveg@synaptics.com> |
| 6 | ;; Version: 2.02 | ||
| 7 | ;; Keywords: extensions | 6 | ;; Keywords: extensions |
| 8 | 7 | ||
| 9 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| @@ -32,16 +31,11 @@ | |||
| 32 | ;; This package was written by Dave Gillespie; it is a complete | 31 | ;; This package was written by Dave Gillespie; it is a complete |
| 33 | ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. | 32 | ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. |
| 34 | ;; | 33 | ;; |
| 35 | ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. | ||
| 36 | ;; | ||
| 37 | ;; Bug reports, comments, and suggestions are welcome! | 34 | ;; Bug reports, comments, and suggestions are welcome! |
| 38 | 35 | ||
| 39 | ;; This file contains portions of the Common Lisp extensions | 36 | ;; This file contains portions of the Common Lisp extensions |
| 40 | ;; package which are autoloaded since they are relatively obscure. | 37 | ;; package which are autoloaded since they are relatively obscure. |
| 41 | 38 | ||
| 42 | ;; See cl.el for Change Log. | ||
| 43 | |||
| 44 | |||
| 45 | ;;; Code: | 39 | ;;; Code: |
| 46 | 40 | ||
| 47 | (or (memq 'cl-19 features) | 41 | (or (memq 'cl-19 features) |
| @@ -55,9 +49,6 @@ | |||
| 55 | (defmacro cl-pop (place) | 49 | (defmacro cl-pop (place) |
| 56 | (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) | 50 | (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) |
| 57 | 51 | ||
| 58 | (defvar cl-emacs-type) | ||
| 59 | |||
| 60 | |||
| 61 | ;;; Type coercion. | 52 | ;;; Type coercion. |
| 62 | 53 | ||
| 63 | (defun coerce (x type) | 54 | (defun coerce (x type) |
| @@ -655,28 +646,16 @@ PROPLIST is a list of the sort returned by `symbol-plist'." | |||
| 655 | 646 | ||
| 656 | (defun cl-make-hash-table (&rest cl-keys) | 647 | (defun cl-make-hash-table (&rest cl-keys) |
| 657 | "Make an empty Common Lisp-style hash-table. | 648 | "Make an empty Common Lisp-style hash-table. |
| 658 | If :test is `eq', this can use Lucid Emacs built-in hash-tables. | ||
| 659 | In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. | ||
| 660 | Keywords supported: :test :size | 649 | Keywords supported: :test :size |
| 661 | The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." | 650 | The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." |
| 662 | (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql)) | 651 | (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql)) |
| 663 | (cl-size (or (car (cdr (memq ':size cl-keys))) 20))) | 652 | (cl-size (or (car (cdr (memq ':size cl-keys))) 20))) |
| 664 | (if (and (eq cl-test 'eq) (fboundp 'make-hashtable)) | 653 | (make-hash-table :size cl-size :test cl-size))) |
| 665 | (funcall 'make-hashtable cl-size) | ||
| 666 | (list 'cl-hash-table-tag cl-test | ||
| 667 | (if (> cl-size 1) (make-vector cl-size 0) | ||
| 668 | (let ((sym (make-symbol "--hashsym--"))) (set sym nil) sym)) | ||
| 669 | 0)))) | ||
| 670 | |||
| 671 | (defvar cl-lucid-hash-tag | ||
| 672 | (if (and (fboundp 'make-hashtable) (vectorp (make-hashtable 1))) | ||
| 673 | (aref (make-hashtable 1) 0) (make-symbol "--cl-hash-tag--"))) | ||
| 674 | 654 | ||
| 675 | (defun cl-hash-table-p (x) | 655 | (defun cl-hash-table-p (x) |
| 676 | "Return t if OBJECT is a hash table." | 656 | "Return t if OBJECT is a hash table." |
| 677 | (or (eq (car-safe x) 'cl-hash-table-tag) | 657 | (or (hash-table-p x) |
| 678 | (and (vectorp x) (= (length x) 4) (eq (aref x 0) cl-lucid-hash-tag)) | 658 | (eq (car-safe x) 'cl-hash-table-tag))) |
| 679 | (and (fboundp 'hashtablep) (funcall 'hashtablep x)))) | ||
| 680 | 659 | ||
| 681 | (defun cl-not-hash-table (x &optional y &rest z) | 660 | (defun cl-not-hash-table (x &optional y &rest z) |
| 682 | (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x)))) | 661 | (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x)))) |
| @@ -782,7 +761,9 @@ The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." | |||
| 782 | (defun cl-hash-table-count (table) | 761 | (defun cl-hash-table-count (table) |
| 783 | "Return the number of entries in HASH-TABLE." | 762 | "Return the number of entries in HASH-TABLE." |
| 784 | (or (cl-hash-table-p table) (cl-not-hash-table table)) | 763 | (or (cl-hash-table-p table) (cl-not-hash-table table)) |
| 785 | (if (consp table) (nth 3 table) (funcall 'hashtable-fullness table))) | 764 | (if (consp table) |
| 765 | (nth 3 table) | ||
| 766 | (hash-table-count table))) | ||
| 786 | 767 | ||
| 787 | 768 | ||
| 788 | ;;; Some debugging aids. | 769 | ;;; Some debugging aids. |