[Guile-commits] 11/19: Contification uses 'cons primcall

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit a80a5ade781f534959ad12b8c316d1bbb7673758
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jun 22 12:21:10 2023 +0200

    Contification uses 'cons primcall
    
    * module/language/cps/contification.scm (apply-contification): Reify
    'cons instead of using the lower-level scm-set! etc.
---
 module/language/cps/contification.scm | 17 ++++-------------
 1 file changed, 4 insertions(+), 13 deletions(-)

diff --git a/module/language/cps/contification.scm 
b/module/language/cps/contification.scm
index 7a05fa241..5167e4d3a 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2021, 2023 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -426,20 +426,11 @@ function set."
            (build-term ($continue k src ($const '())))))
         ((v . vals)
          (with-cps cps
-           (letv pair tail)
-           (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 v)))))
+           (letv tail)
            (letk ktail
                  ($kargs ('tail) (tail)
-                   ($continue khead src
-                     ($primcall 'allocate-words/immediate '(pair . 2) ()))))
+                   ($continue k src
+                     ($primcall 'cons #f (v tail)))))
            ($ (build-list ktail src vals))))))
     (cond
      ((and (not rest) (eqv? (length vals) nreq))