diff options
author | Andy Wingo <wingo@pobox.com> | 2017-11-21 16:09:30 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-11-24 10:37:50 +0100 |
commit | 980de88902ec7002b174c63a817c0f1cfe73fa1a (patch) | |
tree | 922415e011fc96822128750821ff5a3f06586198 /module | |
parent | 72c31075394b6b6f365c7a78964dc8feeb068ade (diff) | |
download | guile-980de88902ec7002b174c63a817c0f1cfe73fa1a.tar.gz |
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.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/cps/types.scm | 1 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 10 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 3 |
3 files changed, 13 insertions, 1 deletions
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index 6aec93b5a..63ee1ce8b 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 7d7100fa7..cb43447bb 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 646eea0c1..c9e1fc0e4 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)) |