diff options
author | Andy Wingo <wingo@pobox.com> | 2020-03-23 14:45:29 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-03-23 14:49:03 +0100 |
commit | ef6f7ce70bfb9310cfec2a87a0a26ad7b9ab355b (patch) | |
tree | 73448eb0bae0d62f1ade3a62392f16fee65c88a7 | |
parent | b62d849d369ad95572a6a83f243045a5b81c7d00 (diff) | |
download | guile-ef6f7ce70bfb9310cfec2a87a0a26ad7b9ab355b.tar.gz |
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.
-rw-r--r-- | module/language/cps/specialize-numbers.scm | 25 |
1 files changed, 23 insertions, 2 deletions
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index 7f7a70a09..7fa8741bb 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 |