[Guile-commits] 19/30: Add exact-integer? as interesting Tree-IL effect-free primitive

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 980de88902ec7002b174c63a817c0f1cfe73fa1a
Author: Andy Wingo <address@hidden>
Date:   Tue Nov 21 16:09:30 2017 +0100

    Add exact-integer? as interesting Tree-IL effect-free primitive
    
    * module/language/tree-il/primitives.scm (*interesting-primitive-names*):
      (*effect-free-primitives*, *effect+exception-free-primitives*): Detect
      use of exact-integer?.
    * module/language/tree-il/compile-cps.scm (canonicalize): Compile
      exact-integer? to a fixnum?-or-bignum? check.
---
 module/language/cps/types.scm           |  1 -
 module/language/tree-il/compile-cps.scm | 10 ++++++++++
 module/language/tree-il/primitives.scm  |  3 +++
 3 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 6aec93b..63ee1ce 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1352,7 +1352,6 @@ minimum, and maximum."
 ;; FIXME: If it's a flonum it may be an integer, but if it's not an
 ;; integer it also may be still be a flonum.
 ;; (define-simple-type-predicate-inferrer integer? (logior &exact-integer 
&flonum))
-(define-simple-type-predicate-inferrer exact-integer? &exact-integer)
 
 (define-simple-type-checker (exact? &number))
 (define-type-inferrer (exact? val result)
diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index 7d7100f..cb43447 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1072,6 +1072,16 @@ integer."
        (($ <conditional>)
         (reduce-conditional exp))
 
+       (($ <primcall> src 'exact-integer? (x))
+        ;; Both fixnum? and bignum? are branching primitives.
+        (with-lexicals src (x)
+          (make-conditional
+           src (make-primcall src 'fixnum? (list x))
+           (make-const src #t)
+           (make-conditional src (make-primcall src 'bignum? (list x))
+                             (make-const src #t)
+                             (make-const src #f)))))
+
        (($ <primcall> src '<= (a b))
         ;; No need to reduce as < is a branching primitive.
         (make-conditional src (make-primcall src '< (list b a))
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 646eea0..c9e1fc0 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -57,6 +57,7 @@
     procedure? thunk?
 
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
+    exact-integer?
 
     char<? char<=? char>=? char>?
 
@@ -174,6 +175,7 @@
     symbol? variable? vector? struct? string? number? char?
     bytevector? keyword? bitvector? atomic-box?
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
+    exact-integer?
     char<? char<=? char>=? char>?
     integer->char char->integer number->string string->number
     struct-vtable
@@ -194,6 +196,7 @@
     not
     pair? null? nil? list?
     symbol? variable? vector? struct? string? number? char?
+    exact-integer?
     bytevector? keyword? bitvector?
     procedure? thunk? atomic-box?
     acons cons cons* list vector))