[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp f923de6 6/8: * Fix `comp-cstr-to-type-spec'
From: |
Andrea Corallo |
Subject: |
feature/native-comp f923de6 6/8: * Fix `comp-cstr-to-type-spec' |
Date: |
Sat, 5 Dec 2020 17:07:33 -0500 (EST) |
branch: feature/native-comp
commit f923de6853a4958f1e50afef683f95ea5fcd31a1
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
* Fix `comp-cstr-to-type-spec'
* lisp/emacs-lisp/comp-cstr.el (comp-star-or-num-p): New predicate.
(comp-type-spec-to-cstr): Make use of.
(comp-cstr-to-type-spec): Output correctly type specifiers
as (not (or integer ...
---
lisp/emacs-lisp/comp-cstr.el | 85 +++++++++++++++++++++++---------------------
1 file changed, 44 insertions(+), 41 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 3aad3dc..5a45294 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -175,6 +175,9 @@ Integer values are handled in the `range' slot.")
;;; Integer range handling
+(defsubst comp-star-or-num-p (x)
+ (or (numberp x) (eq '* x)))
+
(defsubst comp-range-1+ (x)
(if (symbolp x)
x
@@ -484,46 +487,44 @@ DST is returned."
(defun comp-type-spec-to-cstr (type-spec &optional fn)
"Convert a type specifier TYPE-SPEC into a `comp-cstr'.
FN non-nil indicates we are parsing a function lambda list."
- (cl-flet ((star-or-num (x)
- (or (numberp x) (eq '* x))))
- (pcase type-spec
- ((and (or '&optional '&rest) x)
- (if fn
- x
- (error "Invalid `%s` in type specifier" x)))
- ('fixnum
- (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
- ('boolean
- (comp-type-spec-to-cstr '(member t nil)))
- ('null (comp-value-to-cstr nil))
- ((pred atom)
- (comp-type-to-cstr type-spec))
- (`(or . ,rest)
- (apply #'comp-cstr-union-make
- (mapcar #'comp-type-spec-to-cstr rest)))
- (`(and . ,rest)
- (apply #'comp-cstr-intersection-make
- (mapcar #'comp-type-spec-to-cstr rest)))
- (`(not ,cstr)
- (comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
- (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
- (comp-irange-to-cstr `(,l . ,h)))
- (`(integer * ,(and (pred integerp) h))
- (comp-irange-to-cstr `(- . ,h)))
- (`(integer ,(and (pred integerp) l) *)
- (comp-irange-to-cstr `(,l . +)))
- (`(float ,(pred star-or-num) ,(pred star-or-num))
- ;; No float range support :/
- (comp-type-to-cstr 'float))
- (`(member . ,rest)
- (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
- (`(function ,args ,ret)
- (make-comp-cstr-f
- :args (mapcar (lambda (x)
- (comp-type-spec-to-cstr x t))
- args)
- :ret (comp-type-spec-to-cstr ret)))
- (_ (error "Invalid type specifier")))))
+ (pcase type-spec
+ ((and (or '&optional '&rest) x)
+ (if fn
+ x
+ (error "Invalid `%s` in type specifier" x)))
+ ('fixnum
+ (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
+ ('boolean
+ (comp-type-spec-to-cstr '(member t nil)))
+ ('null (comp-value-to-cstr nil))
+ ((pred atom)
+ (comp-type-to-cstr type-spec))
+ (`(or . ,rest)
+ (apply #'comp-cstr-union-make
+ (mapcar #'comp-type-spec-to-cstr rest)))
+ (`(and . ,rest)
+ (apply #'comp-cstr-intersection-make
+ (mapcar #'comp-type-spec-to-cstr rest)))
+ (`(not ,cstr)
+ (comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
+ (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
+ (comp-irange-to-cstr `(,l . ,h)))
+ (`(integer * ,(and (pred integerp) h))
+ (comp-irange-to-cstr `(- . ,h)))
+ (`(integer ,(and (pred integerp) l) *)
+ (comp-irange-to-cstr `(,l . +)))
+ (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p))
+ ;; No float range support :/
+ (comp-type-to-cstr 'float))
+ (`(member . ,rest)
+ (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
+ (`(function ,args ,ret)
+ (make-comp-cstr-f
+ :args (mapcar (lambda (x)
+ (comp-type-spec-to-cstr x t))
+ args)
+ :ret (comp-type-spec-to-cstr ret)))
+ (_ (error "Invalid type specifier"))))
(defun comp-cstr-to-type-spec (cstr)
"Given CSTR return its type specifier."
@@ -562,7 +563,9 @@ FN non-nil indicates we are parsing a function lambda list."
nil)))
(final
(pcase res
- (`(,(or 'integer 'member) . ,rest)
+ ((or `(member . ,rest)
+ `(integer ,(pred comp-star-or-num-p)
+ ,(pred comp-star-or-num-p)))
(if rest
res
(car res)))
- feature/native-comp updated (eb8d155 -> 09ec39e), Andrea Corallo, 2020/12/05
- feature/native-comp 9b85ae6 1/8: Initial constraint negation support, Andrea Corallo, 2020/12/05
- feature/native-comp 7c1d90a 3/8: Initial support for union of negated constraints, Andrea Corallo, 2020/12/05
- feature/native-comp 726e40f 5/8: Fix union of homogeneously negated input constraints, Andrea Corallo, 2020/12/05
- feature/native-comp f923de6 6/8: * Fix `comp-cstr-to-type-spec',
Andrea Corallo <=
- feature/native-comp 09ec39e 8/8: * Memoize `comp-cstr-union-1', Andrea Corallo, 2020/12/05
- feature/native-comp 1fb249f 2/8: * lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-no-range): Cosmetic., Andrea Corallo, 2020/12/05
- feature/native-comp cbbdb4e 4/8: * Add `with-comp-cstr-accessors' macro., Andrea Corallo, 2020/12/05
- feature/native-comp 2eb41ec 7/8: More improvements to `comp-cstr-union-1' for mixed positive/negative cases, Andrea Corallo, 2020/12/05