mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Add exact-integer? as interesting Tree-IL effect-free primitive

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-11-21 16:09:30 +01:00
parent 72c3107539
commit 980de88902
3 changed files with 13 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

1
module/language/cps/types.scm
View file

@ -1352,7 +1352,6 @@ minimum, and maximum."
;; FIXME: If it's a flonum it may be an integer, but if it's not an ;; 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. ;; integer it also may be still be a flonum.
;; (define-simple-type-predicate-inferrer integer? (logior &exact-integer &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-simple-type-checker (exact? &number))
(define-type-inferrer (exact? val result) (define-type-inferrer (exact? val result)

10
module/language/tree-il/compile-cps.scm
View file

@ -1072,6 +1072,16 @@ integer."
(($ <conditional>) (($ <conditional>)
(reduce-conditional exp)) (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)) (($ <primcall> src '<= (a b))
;; No need to reduce as < is a branching primitive. ;; No need to reduce as < is a branching primitive.
(make-conditional src (make-primcall src '< (list b a)) (make-conditional src (make-primcall src '< (list b a))

3
module/language/tree-il/primitives.scm
View file

@ -57,6 +57,7 @@
procedure? thunk? procedure? thunk?
complex? real? rational? inf? nan? integer? exact? inexact? even? odd? complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
exact-integer?
char<? char<=? char>=? char>? char<? char<=? char>=? char>?
@ -174,6 +175,7 @@
symbol? variable? vector? struct? string? number? char? symbol? variable? vector? struct? string? number? char?
bytevector? keyword? bitvector? atomic-box? bytevector? keyword? bitvector? atomic-box?
complex? real? rational? inf? nan? integer? exact? inexact? even? odd? complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
exact-integer?
char<? char<=? char>=? char>? char<? char<=? char>=? char>?
integer->char char->integer number->string string->number integer->char char->integer number->string string->number
struct-vtable struct-vtable
@ -194,6 +196,7 @@
not not
pair? null? nil? list? pair? null? nil? list?
symbol? variable? vector? struct? string? number? char? symbol? variable? vector? struct? string? number? char?
exact-integer?
bytevector? keyword? bitvector? bytevector? keyword? bitvector?
procedure? thunk? atomic-box? procedure? thunk? atomic-box?
acons cons cons* list vector)) acons cons cons* list vector))