[Guile-commits] branch wip-tailify updated: Include nfree in closure-ref, closure-set primcall params

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch wip-tailify
in repository guile.

The following commit(s) were added to refs/heads/wip-tailify by this push:
     new d66c1c67a Include nfree in closure-ref, closure-set primcall params
d66c1c67a is described below

commit d66c1c67a05fbef8dcd1661d9a5bf69f8e46a78c
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Jul 4 11:01:50 2023 +0200

    Include nfree in closure-ref, closure-set primcall params
    
    * module/language/cps/closure-conversion.scm (convert-one): Add nfree to
    the param.  This will help the wasm target.
    * module/language/cps/effects-analysis.scm (closure-ref, closure-set!):
    * module/language/cps/lower-primcalls.scm (closure-ref,closure-set!):
    Adapt.
---
 module/language/cps/closure-conversion.scm | 4 ++--
 module/language/cps/effects-analysis.scm   | 8 ++++++--
 module/language/cps/lower-primcalls.scm    | 4 ++--
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/module/language/cps/closure-conversion.scm 
b/module/language/cps/closure-conversion.scm
index 424a249be..72f0a12ca 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -526,7 +526,7 @@ Otherwise @var{var} is bound, so @var{k} is called with 
@var{var}."
                    (ref (cond
                          ((not self-known?)
                           (build-exp
-                            ($primcall 'closure-ref idx (self))))
+                            ($primcall 'closure-ref `(,idx . ,nfree) (self))))
                          ((= nfree 2)
                           (build-exp
                             ($primcall (match idx (0 'car) (1 'cdr)) #f
@@ -628,7 +628,7 @@ bound to @var{closure}, and continue to @var{k}."
                   ((not known?)
                    (lambda (idx val)
                      (build-exp
-                       ($primcall 'closure-set! idx (closure val)))))
+                       ($primcall 'closure-set! `(,idx . ,count) (closure 
val)))))
                   ((= count 2)
                    (lambda (idx val)
                      (match idx
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index 46a033e08..c82dc9d0e 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -483,8 +483,12 @@ the LABELS that are clobbered by the effects of LABEL."
   ((string-set! str idx cp)        (&write-object &string))
 
   ((make-closure code)             (&allocate &closure))
-  ((closure-ref code)              (&read-field &closure param))
-  ((closure-set! code)             (&write-field &closure param)))
+  ((closure-ref code)              (match param
+                                     ((idx . nfree)
+                                      (&read-field &closure idx))))
+  ((closure-set! code)             (match param
+                                     ((idx . nfree)
+                                      (&write-field &closure idx)))))
 
 (define-primitive-effects* param
   ((allocate-words size)           (&allocate (annotation->memory-kind param)))
diff --git a/module/language/cps/lower-primcalls.scm 
b/module/language/cps/lower-primcalls.scm
index f1787b3f2..5a07113be 100644
--- a/module/language/cps/lower-primcalls.scm
+++ b/module/language/cps/lower-primcalls.scm
@@ -551,7 +551,7 @@
         ($primcall 'allocate-words/immediate `(closure . ,nwords) ())))))
 
 ;; precondition: closure is closure, idx is in range
-(define-primcall-lowerer (closure-ref cps k src idx (closure))
+(define-primcall-lowerer (closure-ref cps k src (idx . nfree) (closure))
   (let ((pos (+ idx 2)))
     (with-cps cps
       (build-term
@@ -559,7 +559,7 @@
           ($primcall 'scm-ref/immediate `(closure . ,pos) (closure)))))))
 
 ;; precondition: closure is clodure, idx is in range
-(define-primcall-lowerer (closure-set! cps k src idx (closure val))
+(define-primcall-lowerer (closure-set! cps k src (idx . nfree) (closure val))
   (let ((pos (+ idx 2)))
     (with-cps cps
       (build-term