master: Make some prose less bad.
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 51e87c2de7a9ec2a824bd33c2851946199606f90 (commit)
from 6125836b9de5c128d2e9eb0f6205cf0a7c27fcc2 (commit)
- Log -----------------------------------------------------------------
commit 51e87c2de7a9ec2a824bd33c2851946199606f90
Author: Charles Zhang <[email protected]>
Date: Tue Aug 11 01:38:53 2026 +0200
Make some prose less bad.
For some reason gen. ai is still awful at writing comprehensible
prose, so re-do the comments manually. (I actually published the last
set of commits prematurely before getting a chance to fix the writing
and other details, though the code was checked already).
---
src/compiler/constraint.lisp | 30 ++++++++-----------------
src/compiler/ir1opt.lisp | 53 ++++++++++++++------------------------------
src/compiler/main.lisp | 26 +++++++++-------------
tests/compiler.pure.lisp | 5 ++---
4 files changed, 38 insertions(+), 76 deletions(-)
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 1ecb59ca2..8c00aefab 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -1451,36 +1451,24 @@
(let ((fun (combination-lambda node))
(call-in (combination-constraints-in node)))
(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.
+ ;; 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)
(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))
+ 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))))
+ 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*
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 43d1cea2c..47e14a921 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -2598,16 +2598,15 @@
;;; The type VAR converges to when its value is fed back through
;;; COMBINATION, a known function of VAR, starting from INITIAL-TYPE.
-;;; NIL if it does not converge. (SETQ X (NREVERSE X)) is the shape, as
-;;; is a local call handing (NREVERSE X) to X's own parameter position.
+;;; Return NIL if doing this will not converge.
;;;
;;; Feeding a type derived from a variable back into that variable is
-;;; where iterating a union upward would need widening. This does not
-;;; iterate: it derives once, unions, derives again, and takes the
-;;; result only if the second derivation agrees with the first, so what
-;;; it returns is a fixpoint it has checked. Numeric bounds are the
-;;; usual reason for not converging, so failing that it tries again
-;;; with the bounds dropped.
+;;; where iterating a union upward would need widening to prevent
+;;; ascending up the type lattice forever. To avoid that, we do only
+;;; one step, and take the result of deriving and unioning only if the
+;;; second derivation agrees with the first to get a fast
+;;; fixpiint. Numeric bounds are the usual reason for not converging,
+;;; so failing that it tries again with the bounds dropped.
(defun converged-type-of-combination (var combination initial-type)
(let* ((info (combination-fun-info combination))
(deriver (and info
@@ -2969,18 +2968,9 @@
(let ((type (sb-kernel::%type-union 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.
+ ;; If we are still optimistically solving for the
+ ;; type of VAR, do not propagate the conservative
+ ;; type to its refs yet.
((lambda-var-optimistic-type var))
(t
(propagate-to-refs var type)))))
@@ -3142,8 +3132,6 @@
(reoptimize-node dest))))
t))))
-;;; Return the lambda variable referenced by USE if it is eligible for
-;;; optimistic type inference.
;;; The LAMBDA-VAR ARG references, looking through a cast.
(defun combination-arg-lambda-var (arg)
(and arg
@@ -3152,6 +3140,8 @@
(and (cast-p use)
(lvar-lambda-var (cast-value use)))))))
+;;; Return the lambda variable referenced by USE if it is eligible for
+;;; optimistic type inference.
(defun optimistic-var (use)
(and (ref-p use)
(let ((leaf (ref-leaf use)))
@@ -3181,11 +3171,8 @@
types
(list (lvar-type arg))))))
-;;; True if ARG carries VAR forward from its own previous value rather
-;;; than delivering an unrelated one: the local call spelling of
-;;; (SETQ X (NREVERSE X)) or (SETQ I (1+ I)). What such an argument
-;;; contributes has to be computed from VAR's optimistic type, since its
-;;; LVAR-TYPE was derived from a VAR that is still T.
+;;; Return true if ARG carries VAR forward from its own previous value
+;;; rather than delivering an unrelated one.
(defun optimistic-step-p (arg var)
(let ((use (and arg (principal-lvar-ref-use arg t))))
(and (combination-p use)
@@ -3196,15 +3183,9 @@
(combination-args use))
t)))
-;;; The optimistic type of VAR, given BASE, the union of what its
-;;; arguments contribute outright, and STEPS, the lvars of the arguments
-;;; that step it from its own previous value.
-;;;
-;;; The same answers PROPAGATE-FROM-SETS reaches for a variable with
-;;; assignments, and in the same order, since a step is the same thing
-;;; whether it arrives by SETQ or as an argument: a loop counter's
-;;; bounds if the steps are increments, otherwise a checked fixpoint if
-;;; there is a single step to derive through, otherwise the plain union.
+;;; Return the optimistic type of VAR, given BASE, the union of what
+;;; its arguments contribute outright, and STEPS, the lvars of the
+;;; arguments that step it from its own previous value.
(defun optimistic-assumed-type (var base steps)
(or (and steps
(neq base *empty-type*)
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index f67d84f01..fcb296154 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -423,24 +423,18 @@ necessary, since type inference may take arbitrarily long to converge.")
(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.
+ ;; Don't count optimistic type publishing towards the
+ ;; iteration budget, as it is cheaper than the rest of
+ ;; ir1 optimization.
(when walk-reoptimized
(incf count))
- (when (and (>= count *max-optimize-iterations*)
- (not (component-reanalyze component))
- (eq (component-reoptimize component) :maybe))
- (maybe-mumble "*")
- (event ir1-optimize-maxed-out)
- (ir1-optimize-last-effort component)
- (return)))
+ (when (and (>= count *max-optimize-iterations*)
+ (not (component-reanalyze component))
+ (eq (component-reoptimize component) :maybe))
+ (maybe-mumble "*")
+ (event ir1-optimize-maxed-out)
+ (ir1-optimize-last-effort component)
+ (return)))
(t
(return))))
(when (setq fastp (>= count *max-optimize-iterations*))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index f09e6787c..927df414e 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -6408,9 +6408,8 @@
0)
'integer))))
-;;; 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.
+;;; Check that the types from loops written with DO and with local
+;;; calls infer to the same type.
(with-test (:name (:local-call-arg-type :spelling-parity))
(labels ((as-do (step init)
`(lambda (n)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL