common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

constraint: Inherit EQL var constraints from local calls as well.

Browse source 
(defun f ()
  (declare (optimize speed))
  (labels ((phi (index)
             (declare (type (integer 0) index))
             (if (> index 9)
                 nil
                 (rec 0 index)))
           (rec (zoot gindex)
             (declare (fixnum zoot))
             (if (< zoot 5)
                 (rec (1+ zoot) gindex)
                 (phi (1+ gindex)))))
    (phi 0)))

now no longer produces any notes.

However, we don't have optimistic type propagation in CP itself, so
neither the lower bound nor the integerness of GINDEX or INDEX can be
derived.
This commit is contained in:
Charles Zhang 2026-08-14 03:11:27 +02:00
parent 87608fcd95
commit 6c0c0fdc2c
2 changed files with 33 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/compiler/constraint.lisp
View file

@ -1438,11 +1438,11 @@
(let ((fun (combination-lambda node))
(call-in (combination-constraints-in node)))
(when (functional-kind-eq fun nil assignment optional cleanup)
;; Add type constraints from local call arguments. We
;; clear the existing variable constraints first for
;; local calls which participate in recursive
;; dataflow. (e.g. an iterative loop written
;; functionally instead of with SETQ)
;; Add type constraints and any equality constraints
;; from local call arguments. We clear the existing
;; variable constraints first for local calls which
;; participate in recursive dataflow. (e.g. an iterative
;; loop written functionally instead of with SETQ)
(let ((new (copy-conset gen))
(vars (lambda-vars fun))
(args (combination-args node)))
@ -1453,9 +1453,19 @@
(loop for var in vars
for val in args
when (and val (lambda-var-constraints var))
do (let ((type (lvar-type val)))
do (let* ((arg-var (ok-lvar-lambda-var val gen))
(type (if arg-var
;; Not strictly necessary
;; to grab the type from
;; constraints here
;; straight away, but
;; speeds up convergence.
(type-from-constraints arg-var gen (lvar-type val))
(lvar-type val))))
(when (type-for-constraints-p type)
(conset-add-constraint new 'typep var type nil))))
(conset-add-constraint new 'typep var type nil))
(when arg-var
(inherit-constraints (list var) arg-var gen new))))
(unless (and call-in (conset= call-in new))
(setf (combination-constraints-in node) new)
(when *constraint-blocks-p*

16
tests/compiler.pure.lisp
View file

@ -6456,3 +6456,19 @@
(funcall done nil))))
((t) nil)
((nil) nil)))
(with-test (:name (:local-call-arg-type :constraint-eql-propagate))
(checked-compile '(lambda ()
(declare (optimize speed))
(labels ((phi (index)
(declare (type (integer 0) index))
(if (> index 9)
nil
(rec 0 index)))
(rec (zoot gindex)
(declare (fixnum zoot))
(if (< zoot 5)
(rec (1+ zoot) gindex)
(phi (1+ gindex)))))
(phi 0)))
:allow-notes nil))