I've narrowed it down to the named let loop "lp" in this routine in
module/language/cps/specialize-numbers.scm
(define (compute-significant-bits cps types kfun)
"Given the locally inferred types @var{types}, compute a map of VAR ->
BITS indicating the significant bits needed for a variable. BITS may be
#f to indicate all bits, or a non-negative integer indicating a bitmask."
(let ((preds (invert-graph (compute-successors cps kfun))))
(let lp ((worklist (intmap-keys preds)) (visited empty-intset)
(out empty-intmap))
(match (intset-prev worklist)
(#f out)
(label
(let ((worklist (intset-remove worklist label))
(visited* (intset-add visited label)))
(define (continue out*)
(if (and (eq? out out*) (eq? visited visited*))
(lp worklist visited out)
(lp (intset-union worklist (intmap-ref preds label))
visited* out*)))
(define (add-def out var)
(intmap-add out var 0 sigbits-union))
(define (add-defs out vars)
(match vars
(() out)
((var . vars) (add-defs (add-def out var) vars))))
(define (add-unknown-use out var)
(intmap-add out var (inferred-sigbits types label var)
sigbits-union))
(define (add-unknown-uses out vars)
(match vars
(() out)
((var . vars)
(add-unknown-uses (add-unknown-use out var) vars))))
(continue
(match (intmap-ref cps label)
(($ $kfun src meta self)
(add-def out self))
(($ $kargs names vars ($ $continue k src exp))
(let ((out (add-defs out vars)))
(match exp
((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($
$rec))
;; No uses, so no info added to sigbits.
out)
(($ $values args)
(match (intmap-ref cps k)
(($ $kargs _ vars)
(if (intset-ref visited k)
(fold (lambda (arg var out)
(intmap-add out arg (intmap-ref out var)
sigbits-union))
out args vars)
out))
(($ $ktail)
(add-unknown-uses out args))))
(($ $call proc args)
(add-unknown-use (add-unknown-uses out args) proc))
(($ $callk label proc args)
(add-unknown-use (add-unknown-uses out args) proc))
(($ $branch kt ($ $values (arg)))
(add-unknown-use out arg))
(($ $branch kt ($ $primcall name args))
(add-unknown-uses out args))
(($ $primcall name args)
(let ((h (significant-bits-handler name)))
(if h
(match (intmap-ref cps k)
(($ $kargs _ defs)
(h label types out args defs)))
(add-unknown-uses out args))))
(($ $prompt escape? tag handler)
(add-unknown-use out tag)))))
(_ out)))))))))
