aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love2000-01-05 16:51:08 +0000
committerDave Love2000-01-05 16:51:08 +0000
commit723dd32d78907fe2ba39dc1c2e86296952cfb5ec (patch)
tree9b4749a3dbefb34c2ea742ecd4760e37b113c37c
parentc7f836c751befc88c4c2c230ce1fc4128fcfc893 (diff)
downloademacs-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.el31
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.
658If :test is `eq', this can use Lucid Emacs built-in hash-tables.
659In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists.
660Keywords supported: :test :size 649Keywords supported: :test :size
661The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." 650The 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.