guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 15/19: Tree-IL-to-CPS lowers to high-level object reprs:


From: Andy Wingo
Subject: [Guile-commits] 15/19: Tree-IL-to-CPS lowers to high-level object reprs: pairs
Date: Thu, 22 Jun 2023 10:12:48 -0400 (EDT)

wingo pushed a commit to branch main
in repository guile.

commit 4fb4bebe419a70842d48baafad548851a5c24c1e
Author: Andy Wingo <wingo@pobox.com>
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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]