procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

comp: Recompute type slots after byte compilation for user types

Browse source 
* lisp/emacs-lisp/comp-cstr.el (comp--compute-typeof-types)
(comp--compute--pred-type-h): New functions.
(comp-cstr-ctxt): Make use of.
(comp-cstr-ctxt-update-type-slots): New function.

* lisp/emacs-lisp/comp.el (comp-spill-lap): Use
`comp-cstr-ctxt-update-type-slots'.
This commit is contained in:
Andrea Corallo 2023-05-28 14:49:19 +02:00
parent edcdb4c2ec
commit 56a8d57d03
2 changed files with 30 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

31
lisp/emacs-lisp/comp-cstr.el
View file

@ -102,17 +102,23 @@ Integer values are handled in the `range' slot.")
obarray)
res))
(defun comp--compute-typeof-types ()
(append comp--typeof-builtin-types
(mapcar #'comp--cl-class-hierarchy (comp--all-classes))))
(defun comp--compute--pred-type-h ()
(cl-loop with h = (make-hash-table :test #'eq)
for class-name in (comp--all-classes)
for pred = (get class-name 'cl-deftype-satisfies)
when pred
do (puthash pred class-name h)
finally return h))
(cl-defstruct comp-cstr-ctxt
(typeof-types (append comp--typeof-builtin-types
(mapcar #'comp--cl-class-hierarchy (comp--all-classes)))
(typeof-types (comp--compute-typeof-types)
:type list
:documentation "Type hierarchy.")
(pred-type-h (cl-loop with h = (make-hash-table :test #'eq)
for class-name in (comp--all-classes)
for pred = (get class-name 'cl-deftype-satisfies)
when pred
do (puthash pred class-name h)
finally return h)
(pred-type-h (comp--compute--pred-type-h)
:type hash-table
:documentation "Hash pred -> type.")
(union-typesets-mem (make-hash-table :test #'equal) :type hash-table
@ -135,6 +141,15 @@ Integer values are handled in the `range' slot.")
:documentation "Serve memoization for
`intersection-mem'."))
(defun comp-cstr-ctxt-update-type-slots (ctxt)
"Update the type related slots of CTXT.
This must run after byte compilation in order to account for user
defined types."
(setf (comp-cstr-ctxt-typeof-types ctxt)
(comp--compute-typeof-types))
(setf (comp-cstr-ctxt-pred-type-h ctxt)
(comp--compute--pred-type-h)))
(defmacro with-comp-cstr-accessors (&rest body)
"Define some quick accessor to reduce code vergosity in BODY."
(declare (debug (form body))