master: Constrain local call parameters from their arguments.
apache--- via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via b72c50c389e5c5c5f6e3fe0a4a9aaaf335a290a3 (commit)
from 235a6573976ab5c4a6300cd6777f9209a323f7f3 (commit)
- Log -----------------------------------------------------------------
commit b72c50c389e5c5c5f6e3fe0a4a9aaaf335a290a3
Author: Charles Zhang <[email protected]>
Date: Tue Aug 11 00:31:05 2026 +0200
Constrain local call parameters from their arguments.
A loop written as a local call inferred worse types at its references
than the same loop written with an assignment, and everything that
produced the difference was on the local call side.
Constraint propagation knew nothing about a local function's
parameters. For a LET it adds a TYPEP constraint from the argument the
variable is bound to, but for any other local function it had only
LEAF-DEFINED-TYPE to go on, so the parameters reached the body with
nothing said about them. An imperative loop's variable, meanwhile, is
refined a step per round by exactly this machinery: COMPUTE-BLOCK-IN
joins what each predecessor knows, which around a loop peels one value
of the sequence per iteration until
*DERIVED-NUMERIC-UNION-COMPLEXITY-LIMIT* collapses the rest.
So constrain the parameters at the call. Binding one is an assignment
to it and carries the same two obligations a CSET does: the callee
learns the argument's type, and what was known of the parameter stops
holding -- which matters when the call is recursive, since the
parameter is then one the calling block has constraints about.
COMPUTE-BLOCK-IN already joins these across the call sites.
That alone changes nothing, because PROPAGATE-LOCAL-CALL-ARGS was
narrowing the same variables from a union recomputed out of arguments
derived from the variables themselves. Around a loop that sharpens on
every visit and never settles, and being the narrower of the two it
won. Leave a parameter that is being solved for optimistically to
PUBLISH-OPTIMISTIC-TYPES, the way a variable with sets is left to
PROPAGATE-FROM-SETS. The optimistic side reaches the same answer
convergently and constraint propagation sharpens the references from
there.
With the optimistic side now the only thing narrowing these
parameters, the rate at which it publishes is the rate at which they
sharpen, and IR1-OPTIMIZE-UNTIL-DONE was charging each publication to
*MAX-OPTIMIZE-ITERATIONS*. A pass that found nothing itself and only
published no longer counts against that budget: types only narrow, so
there are finitely many such passes, and the budget still bounds the
passes that do work. Without this, DELETED-CALL-TYPE and
LOCAL-CALLS-TO-&REST run out of rounds with types still stale.
All nine step shapes in (:LOCAL-CALL-ARG-TYPE :SPELLING-PARITY) now
derive identically to their imperative spelling. (ASH X 1), which had
no fixpoint before and drifted with *MAX-OPTIMIZE-ITERATIONS*, settles
on the answer DO reaches and stays there at 3, 6 and 12 iterations.
Implementation and test cases written by Claude Opus 5.
---
src/compiler/constraint.lisp | 43 ++++++++++++++++++++++++++++++-------
src/compiler/ir1opt.lisp | 20 +++++++++++++++---
src/compiler/main.lisp | 25 +++++++++++++++-------
tests/compiler.pure.lisp | 50 ++++++--------------------------------------
4 files changed, 76 insertions(+), 62 deletions(-)
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 240a65202..1ecb59ca2 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -1450,14 +1450,41 @@
(:local
(let ((fun (combination-lambda node))
(call-in (combination-constraints-in node)))
-
- (when (and (functional-kind-eq fun nil assignment optional cleanup)
- (not (and call-in
- (conset= call-in gen))))
- (setf (combination-constraints-in node)
- (copy-conset gen))
- (when *constraint-blocks-p*
- (enqueue-block-for-constraints (lambda-block fun))))))))))
+ (when (functional-kind-eq fun nil assignment optional cleanup)
+ ;; Binding the parameters is an assignment to them, and
+ ;; carries the same two obligations a CSET does: the
+ ;; callee learns the argument's type, and whatever was
+ ;; known of the parameter here stops holding. The second
+ ;; matters when the call is recursive, since then the
+ ;; parameter is one this very block has constraints about.
+ ;;
+ ;; COMPUTE-BLOCK-IN joins these across the call sites, so
+ ;; a parameter carried around a loop is refined a step per
+ ;; round exactly as a variable assigned in one is. Without
+ ;; it a local function's parameters reach its body with
+ ;; nothing said about them beyond their LEAF-DEFINED-TYPE,
+ ;; and a loop written as a local call gets coarser types
+ ;; at its references than the same loop written with an
+ ;; assignment.
+ (let ((new (copy-conset gen))
+ (vars (lambda-vars fun))
+ (args (combination-args node)))
+ ;; Every parameter is unbound before any is bound, the
+ ;; arguments being evaluated in the caller.
+ (loop for var in vars
+ for val in args
+ when (and val (lambda-var-constraints var))
+ do (conset-clear-lambda-var new var))
+ (loop for var in vars
+ for val in args
+ when (and val (lambda-var-constraints var))
+ do (let ((type (lvar-type val)))
+ (when (type-for-constraints-p type)
+ (conset-add-constraint new 'typep var type nil))))
+ (unless (and call-in (conset= call-in new))
+ (setf (combination-constraints-in node) new)
+ (when *constraint-blocks-p*
+ (enqueue-block-for-constraints (lambda-block fun))))))))))))
gen)
(defun constraint-propagate-if (block gen)
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 07bd0ebc1..43d1cea2c 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -2967,9 +2967,23 @@
and type in union
when type do
(let ((type (sb-kernel::%type-union type)))
- (if (basic-var-sets var)
- (setf (leaf-defined-type var) type)
- (propagate-to-refs var type))))
+ (cond ((basic-var-sets var)
+ (setf (leaf-defined-type var) type))
+ ;; A parameter being solved for optimistically has
+ ;; PUBLISH-OPTIMISTIC-TYPES as its one authority,
+ ;; the way a variable with sets has
+ ;; PROPAGATE-FROM-SETS. Narrowing it from here as
+ ;; well is not simply redundant: this union is
+ ;; recomputed from arguments derived from the
+ ;; variable itself, so around a loop it sharpens a
+ ;; step on every visit and never settles, and being
+ ;; the narrower of the two it is the one that
+ ;; survives. The optimistic side reaches the same
+ ;; answers convergently, and constraint propagation
+ ;; sharpens the references from there.
+ ((lambda-var-optimistic-type var))
+ (t
+ (propagate-to-refs var type)))))
;; It's possible to discover new inline calls which may have
;; incompatible argument types, so don't allow reuse of this
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index be48346bc..f67d84f01 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -418,11 +418,22 @@ necessary, since type inference may take arbitrarily long to converge.")
(component-reanalyze component) nil))
(setf (component-reoptimize component) nil)
(ir1-optimize component fastp)
- (unless (component-reoptimize component)
- (publish-optimistic-types component))
- (cond ((component-reoptimize component)
- (setf reoptimized t)
- (incf count)
+ (let ((walk-reoptimized (component-reoptimize component)))
+ (unless walk-reoptimized
+ (publish-optimistic-types component))
+ (cond ((component-reoptimize component)
+ (setf reoptimized t)
+ ;; A pass that found nothing itself and only published
+ ;; optimistic types does not count against the iteration
+ ;; budget. Publishing is how a parameter's type gets
+ ;; sharper a step at a time, and charging a step to the
+ ;; budget leaves a loop written as a local call short of
+ ;; what PROPAGATE-FROM-SETS reaches for the same loop
+ ;; written with an assignment, which refines within a
+ ;; pass and so costs nothing. Types only narrow, so there
+ ;; are finitely many such passes.
+ (when walk-reoptimized
+ (incf count))
(when (and (>= count *max-optimize-iterations*)
(not (component-reanalyze component))
(eq (component-reoptimize component) :maybe))
@@ -430,8 +441,8 @@ necessary, since type inference may take arbitrarily long to converge.")
(event ir1-optimize-maxed-out)
(ir1-optimize-last-effort component)
(return)))
- (t
- (return)))
+ (t
+ (return))))
(when (setq fastp (>= count *max-optimize-iterations*))
(ir1-optimize-last-effort component))
(maybe-mumble (if fastp "-" ".")))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 2f78d9a3d..e3fb083a7 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -6408,8 +6408,9 @@
0)
'integer))))
-;;; Check that the types from loops written with DO and with local
-;;; calls infer to the same type.
+;;; A loop carries the same type whichever way it is written. SSA
+;;; conversion rewrites the first spelling into the second, so any
+;;; disagreement here is a type the conversion would lose.
(with-test (:name (:local-call-arg-type :spelling-parity))
(labels ((as-do (step init)
`(lambda (n)
@@ -6430,52 +6431,13 @@
((cons 1 x) (list 1))
((list x) (list 1))
((1+ x) 1)
- ((logior x 3) 1)))
- (destructuring-bind (step init) case
- (let ((from-do (derived (as-do step init)))
- (from-labels (derived (as-labels step init))))
- (unless (equal from-do from-labels)
- (error "~S: DO derives ~S, LABELS derives ~S"
- step from-do from-labels)))))))
-
-(with-test (:name (:local-call-arg-type :spelling-parity-numeric-steps)
- :fails-on :sbcl)
- (labels ((as-do (step init)
- `(lambda (n)
- (do ((i n (1- i))
- (x ,init ,step))
- ((zerop i) (ctu:compiler-derived-type x)))))
- (as-labels (step init)
- `(lambda (n)
- (labels ((rec (i x)
- (if (zerop i)
- (ctu:compiler-derived-type x)
- (rec (1- i) ,step))))
- (rec n ,init))))
- (derived (form)
- (funcall (checked-compile form) 0)))
- (dolist (case '(((+ x 2) 1)
+ ((+ x 2) 1)
((- x 3) 1)
- ((ash x 1) 1)))
+ ((ash x 1) 1)
+ ((logior x 3) 1)))
(destructuring-bind (step init) case
(let ((from-do (derived (as-do step init)))
(from-labels (derived (as-labels step init))))
(unless (equal from-do from-labels)
(error "~S: DO derives ~S, LABELS derives ~S"
step from-do from-labels)))))))
-
-(with-test (:name (:assignment-convert :lp2162990))
- (checked-compile-and-assert ()
- `(lambda (a)
- (block done
- (let ((done (lambda (&rest values) (return-from done (values-list values))))
- (l (lambda ())))
- (flet ((c (f)
- (funcall f)))
- (declare (inline c))
- (if a
- (c l)
- (c l)))
- (funcall done nil))))
- ((t) nil)
- ((nil) nil)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL