diff options
| -rw-r--r-- | doc/lispref/objects.texi | 21 | ||||
| -rw-r--r-- | doc/lispref/type_hierarchy.jpg | bin | 0 -> 223501 bytes | |||
| -rw-r--r-- | doc/lispref/type_hierarchy.txt | 22 | ||||
| -rw-r--r-- | etc/syncdoc-type-hierarchy.el | 86 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-preloaded.el | 93 | ||||
| -rw-r--r-- | lisp/emacs-lisp/comp-cstr.el | 25 | ||||
| -rw-r--r-- | src/data.c | 2 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/comp-cstr-tests.el | 4 | ||||
| -rw-r--r-- | test/src/comp-tests.el | 4 |
9 files changed, 206 insertions, 51 deletions
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index e6def69454e..9a4c1473d75 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -60,6 +60,7 @@ to use these types can be found in later chapters. * Type Predicates:: Tests related to types. * Equality Predicates:: Tests of equality between any two objects. * Mutability:: Some objects should not be modified. +* Type Hierarchy:: Type Hierarchy. @end menu @node Printed Representation @@ -2496,3 +2497,23 @@ their components. For example, @code{(eq "abc" "abc")} returns literal @code{"abc"}, and returns @code{nil} if it creates two instances. Lisp programs should be written so that they work regardless of whether this optimization is in use. + +@node Type Hierarchy + +Lisp types are organized in a hierarchy, this means that types can +derive from other types. Objects of a type B (which derives from type +A) inherite all the charateristics of type A. This also means that +every objects of type B is at the same time of type A. + +Every type derives from type @code{t}. + +New types can be defined by the user through @code{defclass} or +@code{cl-defstruct}. + +The Lisp Type Hierarchy for primitive types can be represented as +follow: + +@image{type_hierarchy,,,,png} + +For example type @code{list} derives from (is a special kind of) type +@code{sequence} which on itself derives from @code{t}. diff --git a/doc/lispref/type_hierarchy.jpg b/doc/lispref/type_hierarchy.jpg Binary files differnew file mode 100644 index 00000000000..b7eba7d1cf7 --- /dev/null +++ b/doc/lispref/type_hierarchy.jpg diff --git a/doc/lispref/type_hierarchy.txt b/doc/lispref/type_hierarchy.txt new file mode 100644 index 00000000000..c74bc45635b --- /dev/null +++ b/doc/lispref/type_hierarchy.txt @@ -0,0 +1,22 @@ +| Type | Derived Types | +|-------------------+----------------------------------------------------------| +| t | sequence atom | +| sequence | list array | +| atom | class structure tree-sitter-compiled-query | +| | tree-sitter-node tree-sitter-parser user-ptr font-object | +| | font-entity font-spec condvar mutex thread terminal | +| | hash-table frame buffer function window process | +| | window-configuration overlay integer-or-marker | +| | number-or-marker symbol array obarray | +| number | float integer | +| number-or-marker | marker number | +| integer | bignum fixnum | +| symbol | keyword boolean symbol-with-pos | +| array | vector bool-vector char-table string | +| list | null cons | +| integer-or-marker | integer marker | +| compiled-function | byte-code-function | +| function | subr module-function compiled-function | +| boolean | null | +| subr | subr-native-elisp subr-primitive | +| symbol-with-pos | keyword | diff --git a/etc/syncdoc-type-hierarchy.el b/etc/syncdoc-type-hierarchy.el new file mode 100644 index 00000000000..b3dfe63406a --- /dev/null +++ b/etc/syncdoc-type-hierarchy.el @@ -0,0 +1,86 @@ +;;; syncdoc-type-hierarchy.el--- -*- lexical-binding: t -*- + +;; Copyright (C) 2023-2024 Free Software Foundation, Inc. + +;; Author: Andrea Corallo <acorallo@gnu.org> +;; Keywords: documentation + +;; This file is part of GNU Emacs. + +;; 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 of the License, or +;; (at your option) any later version. + +;; 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. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file is used to keep the type hierarchy representation present +;; in the elisp manual in sync with the current type hierarchy. This +;; is specified in `cl--type-hierarchy' in cl-preloaded.el, so each +;; time `cl--type-hierarchy' is modified +;; `syncdoc-update-type-hierarchy' must be run before the +;; documentation is regenerated. + +;; We do not call this directly from make docs in order not to add a +;; dependency on the tool "dot". + +;;; Code: + +(require 'cl-lib) +(require 'org-table) + +(defconst syncdoc-lispref-dir (concat (file-name-directory + (or load-file-name + buffer-file-name)) + "../doc/lispref/")) + +(defun syncdoc-insert-dot-content (rankdir) + (maphash (lambda (child parents) + (cl-loop for parent in parents + do (insert " \"" (symbol-name child) "\" -> \"" + (symbol-name parent) "\";\n"))) + cl--direct-supertypes-of-type) + (sort-lines nil (point-min) (point-max)) + + (goto-char (point-min)) + (insert "digraph {\n rankdir=\"" rankdir "\";\n") + (goto-char (point-max)) + (insert "}\n")) + +(defun syncdoc-make-type-table (file) + (with-temp-file file + (insert "|Type| Derived Types|\n|-\n") + (cl-loop for (type . children) in cl--type-hierarchy + do (insert "|" (symbol-name type) " |") + do (cl-loop with x = 0 + for child in children + for child-len = (length (symbol-name child)) + when (> (+ x child-len 2) 60) + do (progn + (insert "|\n||") + (setq x 0)) + do (insert (symbol-name child) " ") + do (cl-incf x (1+ child-len)) ) + do (insert "\n")) + (org-table-align))) + +(defun syncdoc-update-type-hierarchy () + "Update the type hierarchy representation used by the elisp manual." + (interactive) + (with-temp-buffer + (syncdoc-insert-dot-content "LR") + (call-process-region nil nil "dot" t (current-buffer) nil "-Tjpg" "-o" + (expand-file-name "type_hierarchy.jpg" + syncdoc-lispref-dir))) + (syncdoc-make-type-table (expand-file-name "type_hierarchy.txt" + syncdoc-lispref-dir))) + +;;; syncdoc-type-hierarchy.el ends here diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 840219c2260..30753bcd5c5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -50,45 +50,70 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defconst cl--typeof-types - ;; Hand made from the source code of `type-of'. - '((integer number integer-or-marker number-or-marker atom) - (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom) - (cons list sequence) - ;; Markers aren't `numberp', yet they are accepted wherever integers are - ;; accepted, pretty much. - (marker integer-or-marker number-or-marker atom) - (overlay atom) (float number number-or-marker atom) - (window-configuration atom) (process atom) (window atom) - ;; FIXME: We'd want to put `function' here, but that's only true - ;; for those `subr's which aren't special forms! - (subr atom) - ;; FIXME: We should probably reverse the order between - ;; `compiled-function' and `byte-code-function' since arguably - ;; `subr' is also "compiled functions" but not "byte code functions", - ;; but it would require changing the value returned by `type-of' for - ;; byte code objects, which risks breaking existing code, which doesn't - ;; seem worth the trouble. - (compiled-function byte-code-function function atom) - (module-function function atom) - (buffer atom) (char-table array sequence atom) - (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) (obarray atom) - (thread atom) (mutex atom) (condvar atom) - (font-spec atom) (font-entity atom) (font-object atom) - (vector array sequence atom) - (user-ptr atom) - (tree-sitter-parser atom) - (tree-sitter-node atom) - (tree-sitter-compiled-query atom) - (native-comp-unit atom) - ;; Plus, really hand made: - (null symbol list sequence atom)) + +(defconst cl--type-hierarchy + ;; Please run `sycdoc-update-type-hierarchy' in + ;; etc/syncdoc-type-hierarchy.el each time this is updated to + ;; reflect in the documentation. + '((t sequence atom) + (sequence list array) + (atom + class structure tree-sitter-compiled-query tree-sitter-node + tree-sitter-parser user-ptr font-object font-entity font-spec + condvar mutex thread terminal hash-table frame buffer function + window process window-configuration overlay integer-or-marker + number-or-marker symbol array obarray) + (number float integer) + (number-or-marker marker number) + (integer bignum fixnum) + (symbol keyword boolean symbol-with-pos) + (array vector bool-vector char-table string) + (list null cons) + (integer-or-marker integer marker) + (compiled-function byte-code-function) + (function subr module-function compiled-function) + (boolean null) + (subr subr-native-elisp subr-primitive) + (symbol-with-pos keyword)) + "List of lists describing all the edges of the builtin type +hierarchy. +Each sublist is in the form (TYPE . DIRECT_SUBTYPES)" + ;; Given type hierarchy is a DAG (but mostly a tree) I believe this + ;; is the most compact way to express it. + ) + +(defconst cl--direct-supertypes-of-type + (make-hash-table :test #'eq) + "Hash table TYPE -> SUPERTYPES.") + +(cl-loop + for (parent . children) in cl--type-hierarchy + do (cl-loop + for child in children + do (cl-pushnew parent (gethash child cl--direct-supertypes-of-type)))) + +(defconst cl--typeof-types nil "Alist of supertypes. Each element has the form (TYPE . SUPERTYPES) where TYPE is one of the symbols returned by `type-of', and SUPERTYPES is the list of its supertypes from the most specific to least specific.") +(defun cl--supertypes-for-typeof-types (type) + (cl-loop with agenda = (list type) + while agenda + for element = (car agenda) + unless (or (eq element t) ;; no t in `cl--typeof-types'. + (memq element res)) + append (list element) into res + do (cl-loop for c in (gethash element cl--direct-supertypes-of-type) + do (setq agenda (append agenda (list c)))) + do (setq agenda (cdr agenda)) + finally (cl-return res))) + +(maphash (lambda (type _) + (push (cl--supertypes-for-typeof-types type) cl--typeof-types)) + cl--direct-supertypes-of-type) + (defconst cl--all-builtin-types (delete-dups (copy-sequence (apply #'append cl--typeof-types)))) diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 48e3645629b..55d92841cd5 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -272,18 +272,19 @@ Return them as multiple value." (symbol-name y))) (defun comp--direct-supertypes (type) - "Return the direct supertypes of TYPE." - (let ((supers (comp-supertypes type))) - (cl-assert (eq type (car supers))) - (cl-loop - with notdirect = nil - with direct = nil - for parent in (cdr supers) - unless (memq parent notdirect) - do (progn - (push parent direct) - (setq notdirect (append notdirect (comp-supertypes parent)))) - finally return direct))) + (or + (gethash type cl--direct-supertypes-of-type) + (let ((supers (comp-supertypes type))) + (cl-assert (eq type (car supers))) + (cl-loop + with notdirect = nil + with direct = nil + for parent in (cdr supers) + unless (memq parent notdirect) + do (progn + (push parent direct) + (setq notdirect (append notdirect (comp-supertypes parent)))) + finally return direct)))) (defsubst comp-subtype-p (type1 type2) "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise." diff --git a/src/data.c b/src/data.c index da507901b76..c87b5317618 100644 --- a/src/data.c +++ b/src/data.c @@ -211,7 +211,7 @@ for example, (type-of 1) returns `integer'. */) return Qcons; case Lisp_Vectorlike: - /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */ + /* WARNING!! Keep 'cl--type-hierarchy' in sync with this code!! */ switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index edc70b12d4b..c3a7092819d 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -170,7 +170,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 61 ((and atom (not symbol)) . atom) ;; 62 - ((and atom (not string)) . (or array sequence atom)) + ((and atom (not string)) . (or array atom)) ;; 63 Conservative ((and symbol (not (member foo))) . symbol) ;; 64 Conservative @@ -196,7 +196,7 @@ The arg is an alist of: type specifier -> expected type specifier." ;; 74 ((and boolean (or number marker)) . nil) ;; 75 - ((and atom (or number marker)) . number-or-marker) + ((and atom (or number marker)) . (or integer-or-marker number-or-marker)) ;; 76 ((and symbol (or number marker)) . nil) ;; 77 diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index fbcb6ca9560..67d632823b2 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1029,7 +1029,7 @@ Return a list of results." (if (= x y) x 'foo)) - '(or (member foo) number-or-marker)) + '(or (member foo) number-or-marker integer-or-marker)) ;; 14 ((defun comp-tests-ret-type-spec-f (x) @@ -1169,7 +1169,7 @@ Return a list of results." ((defun comp-tests-ret-type-spec-f (x) (when (> x 1.0) x)) - '(or null number-or-marker)) + '(or null number-or-marker integer-or-marker)) ;; 36 ((defun comp-tests-ret-type-spec-f (x y) |
