[Guile-commits] 06/19: Add effects analysis for new high-level object accessors

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 98178ac3080639913948a3daecf177de5dd1608d
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jun 22 09:15:56 2023 +0200

    Add effects analysis for new high-level object accessors
    
    * module/language/cps/effects-analysis.scm: Add car, box-ref, etc to
    effects analysis.
---
 module/language/cps/effects-analysis.scm | 48 +++++++++++++++++++++++++++++++-
 1 file changed, 47 insertions(+), 1 deletion(-)

diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index cdbc50159..c6439cfd1 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
 ;;; Effects analysis on CPS
 
-;; Copyright (C) 2011-2015,2017-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015,2017-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
@@ -413,6 +413,14 @@ the LABELS that are clobbered by the effects of LABEL."
 
 ;; Generic objects.
 (define (annotation->memory-kind* annotation idx)
+  ;; Lowering from Tree-IL to CPS reifies type-specific constructors and
+  ;; accessors.  For these we can treat e.g. vector-length as completely
+  ;; constant as it can commute with any other instruction: the header
+  ;; initialization write of a vector is not visible.
+  ;;
+  ;; However when these instructions are later lowered to allocate-words
+  ;; with explicit initializers, we need to model the header reads and
+  ;; writes as non-commutative.
   (match (cons annotation idx)
     (('vector . 0) &header)
     (('string . (or 0 1 2 3)) &header)
@@ -439,6 +447,44 @@ the LABELS that are clobbered by the effects of LABEL."
     ('struct &struct)
     ('atomic-box &unknown-memory-kinds)))
 
+(define-primitive-effects* param
+  ((allocate-vector size)          (&allocate &vector))
+  ((allocate-vector/immediate)     (&allocate &vector))
+  ((vector-length v))
+  ((vector-ref/immediate v)        (&read-field &vector param))
+  ((vector-ref v idx)              (&read-object &vector))
+  ((vector-set!/immediate v val)   (&write-field &vector param))
+  ((vector-set! v idx val)         (&write-object &vector))
+
+  ((cons x y)                      (&allocate &pair))
+  ((car pair)                      (&read-field &pair 0))
+  ((cdr pair)                      (&read-field &pair 1))
+  ((set-car! pair val)             (&write-field &pair 0))
+  ((set-cdr! pair val)             (&write-field &pair 1))
+
+  ((box val)                       (&allocate &box))
+  ((box-ref b)                     (&read-object &box))
+  ((box-set! b val)                (&write-object &box))
+
+  ((allocate-struct vtable)        (&allocate &struct))
+  ((vtable-size x))
+  ((vtable-has-unboxed-fields? x))
+  ((vtable-field-boxed? x))
+  ((struct-vtable x))
+  ((struct-ref x)                  (&read-field &struct param))
+  ((struct-set! x y)               (&write-field &struct param))
+
+  ((bv-contents bv))
+  ((bv-length bv))
+
+  ((string-length str))
+  ((string-ref str idx)            (&read-object &string))
+  ((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)))
+
 (define-primitive-effects* param
   ((allocate-words size)           (&allocate (annotation->memory-kind param)))
   ((allocate-words/immediate)      (match param