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

Improve cstr typeset normalization

Browse source 
* test/lisp/emacs-lisp/comp-cstr-tests.el
(comp-cstr-typespec-tests-alist): Add four tests.

* lisp/emacs-lisp/comp-cstr.el (comp--sym-lessp)
(comp--direct-supertype, comp--normalize-typeset0): New functions.
(comp-normalize-typeset): Rework to make use of
'comp--normalize-typeset0'.
(comp--direct-subtypes): New function.
This commit is contained in:
Andrea Corallo 2023-10-18 16:14:45 +02:00
parent 0fd7f785e7
commit 3e193edd68
2 changed files with 59 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -262,12 +262,57 @@ Return them as multiple value."
;;; Type handling.
(defun comp--sym-lessp (x y)
"Like `string-lessp' but for strings."
(string-lessp (symbol-name x)
(symbol-name y)))
(defun comp--direct-supertype (type)
"Return the direct supertype of TYPE."
(cl-loop
named outer
for i in (comp-cstr-ctxt-typeof-types comp-ctxt)
do (cl-loop for (j y) on i
when (eq j type)
do (cl-return-from outer y))))
(defun comp--normalize-typeset0 (typeset)
;; For every type search its supertype. If all the subtypes of that
;; supertype are presents remove all of them, add the identified
;; supertype and restart.
(when typeset
(while (eq 'restart
(cl-loop
named main
for i in typeset
for sup = (comp--direct-supertype i)
for subs = (comp--direct-subtypes sup)
when (and sup
(length> subs 1)
(cl-every (lambda (x) (member x typeset)) subs))
do (cl-loop for s in subs
do (setq typeset (cl-delete s typeset))
finally (progn (push sup typeset)
(cl-return-from main 'restart))))))
typeset))
(defun comp-normalize-typeset (typeset)
"Sort TYPESET and return it."
(cl-sort (cl-remove-duplicates typeset)
(lambda (x y)
(string-lessp (symbol-name x)
(symbol-name y)))))
(cl-sort (comp--normalize-typeset0 (cl-remove-duplicates typeset)) #'comp--sym-lessp))
(defun comp--direct-subtypes (type)
"Return all the direct subtypes of TYPE."
;; TODO memoize.
(cl-sort
(cl-loop for j in (comp-cstr-ctxt-typeof-types comp-ctxt)
for res = (cl-loop for i in j
with last = nil
when (eq i type)
return last
do (setq last i))
when res
collect res)
#'comp--sym-lessp))
(defun comp-supertypes (type)
"Return a list of pairs (supertype . hierarchy-level) for TYPE."

11
test/lisp/emacs-lisp/comp-cstr-tests.el
View file

@ -217,7 +217,16 @@
;; 87
((and (or null integer) (not (or null integer))) . nil)
;; 88
((and (or (member a b c)) (not (or (member a b)))) . (member c)))
((and (or (member a b c)) (not (or (member a b)))) . (member c))
;; 89
((or cons symbol) . list)
;; 90
((or string char-table bool-vector vector) . array)
;; 91
((or string char-table bool-vector vector number) . (or array number))
;; 92
((or string char-table bool-vector vector cons symbol number) .
(or number sequence)))
"Alist type specifier -> expected type specifier."))
(defmacro comp-cstr-synthesize-tests ()