wingo pushed a commit to branch main
in repository guile.
commit 4fb4bebe419a70842d48baafad548851a5c24c1e
Author: Andy Wingo <[email protected]>
AuthorDate: Thu Jun 22 11:23:22 2023 +0200
Tree-IL-to-CPS lowers to high-level object reprs: pairs
* module/language/tree-il/compile-cps.scm: Lower to cons, car, set-car!,
etc.
---
module/language/tree-il/compile-cps.scm | 27 ++++-----------------------
1 file changed, 4 insertions(+), 23 deletions(-)
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index e83192062..7979f4ff1 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -421,25 +421,6 @@
(letk kheap-object ($kargs () () ($branch knot-pair k src pred #f (x))))
(build-term ($branch knot-pair kheap-object src 'heap-object? #f (x)))))
-(define-primcall-converter cons
- (lambda (cps k src op param head tail)
- (with-cps cps
- (letv pair)
- (letk kdone
- ($kargs () ()
- ($continue k src ($values (pair)))))
- (letk ktail
- ($kargs () ()
- ($continue kdone src
- ($primcall 'scm-set!/immediate '(pair . 1) (pair tail)))))
- (letk khead
- ($kargs ('pair) (pair)
- ($continue ktail src
- ($primcall 'scm-set!/immediate '(pair . 0) (pair head)))))
- (build-term
- ($continue khead src
- ($primcall 'allocate-words/immediate '(pair . 2) ()))))))
-
(define-primcall-converter car
(lambda (cps k src op param pair)
(ensure-pair
@@ -448,7 +429,7 @@
(with-cps cps
(build-term
($continue k src
- ($primcall 'scm-ref/immediate '(pair . 0) (pair)))))))))
+ ($primcall 'car #f (pair)))))))))
(define-primcall-converter cdr
(lambda (cps k src op param pair)
@@ -458,7 +439,7 @@
(with-cps cps
(build-term
($continue k src
- ($primcall 'scm-ref/immediate '(pair . 1) (pair)))))))))
+ ($primcall 'cdr #f (pair)))))))))
(define-primcall-converter set-car!
(lambda (cps k src op param pair val)
@@ -469,7 +450,7 @@
(with-cps cps
(build-term
($continue k src
- ($primcall 'scm-set!/immediate '(pair . 0) (pair val)))))))))
+ ($primcall 'set-car! #f (pair val)))))))))
(define-primcall-converter set-cdr!
(lambda (cps k src op param pair val)
@@ -480,7 +461,7 @@
(with-cps cps
(build-term
($continue k src
- ($primcall 'scm-set!/immediate '(pair . 1) (pair val)))))))))
+ ($primcall 'set-cdr! #f (pair val)))))))))
(define-primcall-converter %box-ref
(lambda (cps k src op param box)