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

Enable integer range narrowing under compare and branch

Browse source 
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-set-cmp-range)
	(comp-cstr->, comp-cstr->=, comp-cstr-<, comp-cstr-<=): New
	functions.
	* lisp/emacs-lisp/comp.el (comp-equality-fun-p)
	(comp-range-cmp-fun-p): New functions.
	(comp-collect-rhs): Use `comp-assign-op-p' in place of
	`comp-set-op-p'.
	(comp-negate-range-cmp-fun, comp-reverse-cmp-fun): New functions.
	(comp-emit-assume): Rework to be able to emit also comparision
	assumption.
	(comp-add-cond-cstrs-simple): Update for new `comp-emit-assume'.
	(comp-add-cond-cstrs-simple): Update to emit range assumption.
	(comp-fwprop-insn): Execute range assumptions.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add tests.
This commit is contained in:
Andrea Corallo 2020-12-25 10:57:02 +01:00
parent bd693ccea7
commit 89d5a3a760
3 changed files with 224 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -362,6 +362,22 @@ Return them as multiple value."
(push `(,(1+ last-h) . +) res))
(cl-return (reverse res)))))
(defsubst comp-cstr-set-cmp-range (dst old-dst ext-range)
"Support range comparison functions."
(with-comp-cstr-accessors
(if ext-range
(setf (typeset dst) ()
(valset dst) ()
(range dst) (if (range old-dst)
(comp-range-intersection (range old-dst)
ext-range)
ext-range)
(neg dst) nil)
(setf (typeset dst) (typeset old-dst)
(valset dst) (valset old-dst)
(range dst) (range old-dst)
(neg dst) (neg old-dst)))))
;;; Union specific code.
@ -663,6 +679,58 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
;;; Entry points.
(defun comp-cstr-> (dst old-dst src)
"Constraint DST being > than SRC.
SRC can be either a comp-cstr or an integer."
(with-comp-cstr-accessors
(let ((ext-range
(if (integerp src)
`((,(1+ src) . +))
(when-let* ((range (range src))
(low (cdar (last range)))
(okay (integerp low)))
`((,(1+ low) . +))))))
(comp-cstr-set-cmp-range dst old-dst ext-range))))
(defun comp-cstr->= (dst old-dst src)
"Constraint DST being >= than SRC.
SRC can be either a comp-cstr or an integer."
(with-comp-cstr-accessors
(let ((ext-range
(if (integerp src)
`((,src . +))
(when-let* ((range (range src))
(low (cdar (last range)))
(okay (integerp low)))
`((,low . +))))))
(comp-cstr-set-cmp-range dst old-dst ext-range))))
(defun comp-cstr-< (dst old-dst src)
"Constraint DST being < than SRC.
SRC can be either a comp-cstr or an integer."
(with-comp-cstr-accessors
(let ((ext-range
(if (integerp src)
`((- . ,(1- src)))
(when-let* ((range (range src))
(low (caar (last range)))
(okay (integerp low)))
`((- . ,(1- low)))))))
(comp-cstr-set-cmp-range dst old-dst ext-range))))
(defun comp-cstr-<= (dst old-dst src)
"Constraint DST being > than SRC.
SRC can be either a comp-cstr or an integer."
(with-comp-cstr-accessors
(let ((ext-range
(if (integerp src)
`((- . ,src))
(when-let* ((range (range src))
(low (caar (last range)))
(okay (integerp low)))
`((- . ,low))))))
(comp-cstr-set-cmp-range dst old-dst ext-range))))
(defun comp-cstr-union-no-range (dst &rest srcs)
"Combine SRCS by union set operation setting the result in DST.
Do not propagate the range component.