diff options
author | Andy Wingo <wingo@pobox.com> | 2020-02-12 15:40:14 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-02-12 15:40:14 +0100 |
commit | a706b7e465f1dee3ef6c95655d8e9f43575ec732 (patch) | |
tree | 7eee2945447865ec1965baee90f10336c275ab79 | |
parent | 41d470f0e96875e1e08a72da8478341b5fa70532 (diff) | |
download | guile-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.scm | 21 |
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)) |