mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Fix fixpoint computation in compute-significant-bits

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2020-03-23 14:45:29 +01:00
parent 7839dc444b
commit a58758e782
1 changed files with 23 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

25
module/language/cps/specialize-numbers.scm
View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Copyright (C) 2015, 2016, 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
@ -159,8 +159,29 @@
($continue kunbox-b src
($primcall 'scm->f64 (a)))))))
;; 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