mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 05:30:23 +02:00
Code Activity

Contification uses 'cons primcall

Browse source 
* module/language/cps/contification.scm (apply-contification): Reify
'cons instead of using the lower-level scm-set! etc.
This commit is contained in:
Andy Wingo 2023-06-22 12:21:10 +02:00
parent 26b43f35c5
commit a80a5ade78
1 changed files with 4 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/language/cps/contification.scm
View file

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