mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-05 18:30:24 -08:00
Code Issues Projects Releases Packages Wiki Activity

subtypep: refactor register-interval-type

Browse source 
We use destructuring to bind elements of the type, and both high and low tag
computation follows the same code shape to highlight similarities.
This commit is contained in:
Daniel Kochmański 2023-07-25 12:30:27 +02:00
parent b7a22e904b
commit 19eb060d14
1 changed files with 24 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/lsp/predlib.lsp
View file

@ -1190,29 +1190,30 @@ if not possible."
(defun register-interval-type (interval)
(declare (si::c-local))
(let* ((i interval)
(type (pop i))
(low (if i (pop i) '*))
(high (if i (pop i) '*))
(tag-high (cond ((eq high '*)
+built-in-tag-nil+)
((eq type 'INTEGER)
(setq high (if (consp high)
(ceiling (first high))
(floor (1+ high))))
(register-elementary-interval type high))
((consp high)
(register-elementary-interval type (first high)))
(t
(register-elementary-interval type (list high)))))
(tag-low (register-elementary-interval type
(cond ((or (eq '* low) (not (eq type 'INTEGER)) (integerp low))
low)
((consp low)
(floor (1+ (first low))))
(t
(ceiling low))))))
(logandc2 tag-low tag-high)))
(destructuring-bind (type &optional (low '*) (high '*)) interval
(let ((tag-high
(cond ((eq high '*)
+built-in-tag-nil+)
((eq type 'INTEGER)
(setq high (if (consp high)
(ceiling (first high))
(floor (1+ high))))
(register-elementary-interval type high))
((consp high)
(register-elementary-interval type (first high)))
(t
(register-elementary-interval type (list high)))))
(tag-low
(cond ((eq low '*)
(register-elementary-interval type low))
((eq type 'INTEGER)
(setq low (if (consp low)
(floor (1+ (first low)))
(ceiling low)))
(register-elementary-interval type low))
(t
(register-elementary-interval type low)))))
(logandc2 tag-low tag-high))))
;;; All comparisons between intervals operations may be defined in terms of
;;;