summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-02-12 15:40:14 +0100
committerAndy Wingo <wingo@pobox.com>2020-02-12 15:40:14 +0100
commita706b7e465f1dee3ef6c95655d8e9f43575ec732 (patch)
tree7eee2945447865ec1965baee90f10336c275ab79
parent41d470f0e96875e1e08a72da8478341b5fa70532 (diff)
downloadguile-a706b7e465f1dee3ef6c95655d8e9f43575ec732.tar.gz
Fold (logior 0 INT) to INT
* module/language/cps/type-fold.scm (logior): Integer-valued operands to (logior 0 EXPR) should fold to EXPR.
-rw-r--r--module/language/cps/type-fold.scm21
1 files changed, 20 insertions, 1 deletions
diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index 5cb7447b3..7cefbd2e0 100644
--- 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))