[Guile-commits] 05/05: Baseline compiler no longer swaps rsh/lsh when transforming ash calls.

[Ludovic Courtès]

civodul pushed a commit to branch main
in repository guile.

commit 74abae04aa68dc18676bd84c4a73324b0613475d
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Sep 20 23:27:39 2021 +0200

    Baseline compiler no longer swaps rsh/lsh when transforming ash calls.
    
    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.
---
 module/language/tree-il/compile-bytecode.scm |  4 ++--
 test-suite/tests/numbers.test                | 13 +++++++++++--
 2 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/module/language/tree-il/compile-bytecode.scm 
b/module/language/tree-il/compile-bytecode.scm
index 551ae68..87d903c 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -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
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 59e370e..8f64487 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -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