diff options
author | Andy Wingo <wingo@pobox.com> | 2023-09-15 11:19:49 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-09-15 11:19:55 +0200 |
commit | d5347b59fb25a61c37990db6248072c7cb413a7f (patch) | |
tree | b5bbfe31c9ca817254285f88f6bfe9eb6f7bca84 /module/language | |
parent | 6756aeff9514bff792e9804217161a7d8ca61fe5 (diff) | |
download | guile-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.scm | 11 | ||||
-rw-r--r-- | module/language/tree-il/cps-primitives.scm | 1 |
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) |