wingo pushed a commit to branch main
in repository guile.
commit a80a5ade781f534959ad12b8c316d1bbb7673758
Author: Andy Wingo <[email protected]>
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))
