Fold (logior 0 INT) to INT

* module/language/cps/type-fold.scm (logior): Integer-valued operands
  to (logior 0 EXPR) should fold to EXPR.

diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index 5cb7447b33f4f4363fef24f7e42d42689cb67f1c..7cefbd2e0efa8ee1b256ff3cbec249665061f478 100644 (file)
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -1,5 +1,5 @@
 ;;; Abstract constant folding on CPS
-;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
+;;; Copyright (C) 2014-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 License as
@@ -427,6 +427,25 @@
    (else
     (with-cps cps #f))))
 
+(define-binary-primcall-reducer (logior cps k src param
+                                        arg0 type0 min0 max0
+                                        arg1 type1 min1 max1)
+  (cond
+   ((type<=? (logior type0 type1) &exact-integer)
+    (cond
+     ((= 0 min0 max0)
+      (with-cps cps
+        (build-term
+          ($continue k src ($values (arg1))))))
+     ((= 0 min1 max1)
+      (with-cps cps
+        (build-term
+          ($continue k src ($values (arg0))))))
+     (else
+      (with-cps cps #f))))
+   (else
+    (with-cps cps #f))))
+
 (define-unary-primcall-reducer (u64->scm cps k src constant arg type min max)
   (cond
    ((<= max (target-most-positive-fixnum))