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

Baseline compiler no longer swaps rsh/lsh when transforming ash calls.

Browse source 
Reported by Marius Bakke <marius@gnu.org>
at <https://issues.guix.gnu.org/50696>.

Previously, the baseline compiler would incorrectly emit a right shift
when for, say, (ash x 2), and a left shift for (ash x -2).

* module/language/tree-il/compile-bytecode.scm (canonicalize): When Y is
negative, emit 'rsh', not 'lsh'.
* test-suite/tests/numbers.test ("ash at -O1"): New test.
This commit is contained in:
Ludovic Courtès 2021-09-20 23:27:39 +02:00
parent 330c6ea83f
commit 74abae04aa
2 changed files with 13 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/language/tree-il/compile-bytecode.scm
View file

@ -461,8 +461,8 @@
;; Transform "ash" to lsh / rsh.
(($ <primcall> src 'ash (x ($ <const> src* (? exact-integer? y))))
(if (negative? y)
(make-primcall src 'lsh (list x (make-const src* (- y))))
(make-primcall src 'rsh (list x (make-const src* y)))))
(make-primcall src 'rsh (list x (make-const src* (- y))))
(make-primcall src 'lsh (list x (make-const src* y)))))
;; (throw key subr msg (list x) (list x))
(($ <primcall> src 'throw

13
test-suite/tests/numbers.test
View file

@ -1,6 +1,6 @@
;;;; numbers.test --- tests guile's numbers -*- scheme -*-
;;;; Copyright (C) 2000, 2001, 2003-2006, 2009-2013,
;;;; 2015, 2018 Free Software Foundation, Inc.
;;;; 2015, 2018, 2021 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
@ -19,6 +19,7 @@
(define-module (test-suite test-numbers)
#:use-module (test-suite lib)
#:use-module (ice-9 documentation)
#:autoload (system base compile) (compile)
#:use-module (srfi srfi-1) ; list library
#:use-module (srfi srfi-11)) ; let-values
@ -5468,7 +5469,15 @@
(ash-variant 123 (expt 2 1000)))))
(test-ash-variant 'ash ash floor #f)
(test-ash-variant 'round-ash round-ash round #t))
(test-ash-variant 'round-ash round-ash round #t)
(pass-if-equal "ash at -O1" ;https://issues.guix.gnu.org/50696
'(4 1)
(compile '((lambda (x y)
(list (ash x 2) (ash y -2))) 1 4)
#:to 'value
#:opts '(#:cps? #f #:partial-eval? #f)
#:optimization-level 1)))
;;;
;;; regressions