[Guile-commits] branch master updated: Fix fixpoint computation in compute-significant-bits

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new ef6f7ce  Fix fixpoint computation in compute-significant-bits
ef6f7ce is described below

commit ef6f7ce70bfb9310cfec2a87a0a26ad7b9ab355b
Author: Andy Wingo <address@hidden>
AuthorDate: Mon Mar 23 14:45:29 2020 +0100

    Fix fixpoint computation in compute-significant-bits
    
    * module/language/cps/specialize-numbers.scm (preserve-eq?): New
      helper.
      (sigbits-union): Use the new helper.  Fixes bugs.gnu.org/38486.
      Thanks to Zack Marvel for the bug report and Matt Wette for tracking
      it down.
---
 module/language/cps/specialize-numbers.scm | 25 +++++++++++++++++++++++--
 1 file changed, 23 insertions(+), 2 deletions(-)

diff --git a/module/language/cps/specialize-numbers.scm 
b/module/language/cps/specialize-numbers.scm
index 7f7a70a..7fa8741 100644
--- a/module/language/cps/specialize-numbers.scm
+++ b/module/language/cps/specialize-numbers.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2015, 2016, 2017, 2018, 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -230,8 +230,29 @@
                    ($primcall 'untag-fixnum #f (b-int)))))
     (build-term ($branch kretag kfix src 'fixnum? #f (b-int)))))
 
+;; compute-significant-bits solves a flow equation to compute a
+;; least-fixed-point over the lattice VAR -> BITMASK, where X > Y if
+;; X[VAR] > Y[VAR] for any VAR.  Adjoining VAR -> BITMASK to X results
+;; in a distinct value X' (in the sense of eq?) if and only if X' > X.
+;; This property is used in compute-significant-bits to know when to
+;; stop iterating, and is ensured by intmaps, provided that the `meet'
+;; function passed to `intmap-add' and so on also preserves this
+;; property.
+;;
+;; The meet function for adding bits is `sigbits-union'; the first
+;; argument is the existing value, and the second is the bitmask to
+;; adjoin.  For fixnums, BITMASK' will indeed be distinct if and only if
+;; bits were added.  However for bignums it's possible that (= X' X) but
+;; not (eq? X' X).  This preserve-eq? helper does the impedance matching
+;; for bignums, returning the first value if the values are =.
+(define (preserve-eq? x x*)
+  (if (= x x*)
+      x
+      x*))
+
 (define (sigbits-union x y)
-  (and x y (logior x y)))
+  (and x y
+       (preserve-eq? x (logior x y))))
 
 (define (sigbits-intersect x y)
   (cond