[Guile-commits] 08/19: Add CSE auxiliary definitions for cons, set-car! etc

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 2534326e5e0a32d26041799b9f72070cb53ff8ac
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jun 22 09:16:26 2023 +0200

    Add CSE auxiliary definitions for cons, set-car! etc
    
    * module/language/cps/cse.scm (eliminate-common-subexpressions-in-fun):
    Add cons, set-car!, etc.
---
 module/language/cps/cse.scm | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 3c67a043a..d06f918f4 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.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
@@ -518,6 +518,21 @@ for a label, it isn't known to be constant at that label."
      ((word-set!/immediate p s x)      (x <- word-ref/immediate p s))
      ((pointer-set!/immediate p s x)   (x <- pointer-ref/immediate p s))
 
+     ((p <- cons #f x y)               (x <- car #f p)
+                                       (y <- cdr #f p))
+     ((set-car! #f p x)                (x <- car #f p))
+     ((set-cdr! #f p y)                (y <- cdr #f p))
+
+     ((b <- box #f x)                  (x <- box-ref #f b))
+     ((box-set! #f b x)                (x <- box-ref #f b))
+
+     ((v <- allocate-vector #f n)      (n <- vector-length #f v))
+     ((vector-set!/immediate p v x)    (x <- vector-ref/immediate p v))
+     ((vector-set! #f v i x)           (x <- vector-ref #f v i))
+
+     ((s <- allocate-struct n v)       (v <- struct-vtable #f s))
+     ((struct-set! p s x)              (x <- struct-ref p s))
+
      ((u <- scm->f64 #f s)             (s <- f64->scm #f u))
      ((s <- f64->scm #f u)             (u <- scm->f64 #f s))
      ((u <- scm->u64 #f s)             (s <- u64->scm #f u))