summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-09-15 11:19:49 +0200
committerAndy Wingo <wingo@pobox.com>2023-09-15 11:19:55 +0200
commitd5347b59fb25a61c37990db6248072c7cb413a7f (patch)
treeb5bbfe31c9ca817254285f88f6bfe9eb6f7bca84 /module/language
parent6756aeff9514bff792e9804217161a7d8ca61fe5 (diff)
downloadguile-d5347b59fb25a61c37990db6248072c7cb413a7f.tar.gz
Better compilation of number?
* module/language/cps/guile-vm/lower-primcalls.scm (number?): * module/language/tree-il/cps-primitives.scm (number?): Lower as CPS branching predicate.
Diffstat (limited to 'module/language')
-rw-r--r--module/language/cps/guile-vm/lower-primcalls.scm11
-rw-r--r--module/language/tree-il/cps-primitives.scm1
2 files changed, 12 insertions, 0 deletions
diff --git a/module/language/cps/guile-vm/lower-primcalls.scm b/module/language/cps/guile-vm/lower-primcalls.scm
index 3072bb7bf..cff370431 100644
--- a/module/language/cps/guile-vm/lower-primcalls.scm
+++ b/module/language/cps/guile-vm/lower-primcalls.scm
@@ -612,6 +612,17 @@
(build-term
($continue kcall src ($prim 'procedure?)))))
+(define-branching-primcall-lowerer (number? cps kf kt src #f (x))
+ (with-cps cps
+ (letk kheap-num
+ ($kargs () ()
+ ($branch kf kt src 'heap-number? #f (x))))
+ (letk kheap
+ ($kargs () ()
+ ($branch kf kheap-num src 'heap-object? #f (x))))
+ (build-term
+ ($branch kheap kt src 'fixnum? #f (x)))))
+
(define (lower-primcalls cps)
(with-fresh-name-state cps
(persistent-intmap
diff --git a/module/language/tree-il/cps-primitives.scm b/module/language/tree-il/cps-primitives.scm
index c6ab96471..5e7199d78 100644
--- a/module/language/tree-il/cps-primitives.scm
+++ b/module/language/tree-il/cps-primitives.scm
@@ -194,3 +194,4 @@
(define-branching-primitive = 2)
(define-branching-primitive procedure? 1)
+(define-branching-primitive number? 1)