[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/19: New CPS pass: lower-primcalls
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/19: New CPS pass: lower-primcalls |
Date: |
Thu, 22 Jun 2023 10:12:46 -0400 (EDT) |
wingo pushed a commit to branch main
in repository guile.
commit b974405bce5e2b86c0efdf684bd7eef8bd886a47
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Jun 20 12:23:51 2023 +0200
New CPS pass: lower-primcalls
This pass will implement the specialized lowering of object accessors to
Guile's VM primitives.
* am/bootstrap.am (SOURCES): Add new file.
* module/language/cps/lower-primcalls.scm: New file.
---
am/bootstrap.am | 1 +
module/language/cps/lower-primcalls.scm | 592 ++++++++++++++++++++++++++++++++
2 files changed, 593 insertions(+)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index 16e632f25..ff0d1799e 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -99,6 +99,7 @@ SOURCES = \
language/cps/intset.scm \
language/cps/licm.scm \
language/cps/loop-instrumentation.scm \
+ language/cps/lower-primcalls.scm \
language/cps/optimize.scm \
language/cps/peel-loops.scm \
language/cps/prune-top-level-scopes.scm \
diff --git a/module/language/cps/lower-primcalls.scm
b/module/language/cps/lower-primcalls.scm
new file mode 100644
index 000000000..0b013cc85
--- /dev/null
+++ b/module/language/cps/lower-primcalls.scm
@@ -0,0 +1,592 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 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 License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; When targetting Guile's virtual machine, we can get maximum
+;;; performance by expanding out some compound primcalls, both so that
+;;; they are available to common subexpression elimination and so that
+;;; their lowered forms can be implemented using Guile's low-level VM
+;;; capabilities instead of by call-outs to library routines.
+;;;
+;;; Code:
+
+(define-module (language cps lower-primcalls)
+ #:use-module (ice-9 match)
+ #:use-module (language cps)
+ #:use-module (language cps intmap)
+ #:use-module (language cps utils)
+ #:use-module (language cps with-cps)
+ #:use-module (system base target)
+ #:use-module (system base types internal)
+ #:export (lower-primcalls))
+
+(define *primcall-lowerers* (make-hash-table))
+(define-syntax-rule (define-primcall-lowerer* name proc)
+ (hashq-set! *primcall-lowerers* 'name proc))
+(define-syntax-rule (define-primcall-lowerer (name cps k src param-pat
args-pat)
+ body ...)
+ (define-primcall-lowerer* name
+ (lambda (cps k src param args)
+ (match (cons param args)
+ ((param-pat . args-pat)
+ body ...)))))
+
+(define *branching-primcall-lowerers* (make-hash-table))
+(define-syntax-rule (define-branching-primcall-lowerer* name proc)
+ (hashq-set! *branching-primcall-lowerers* 'name proc))
+(define-syntax-rule (define-branching-primcall-lowerer
+ (name cps kf kt src param-pat args-pat)
+ body ...)
+ (define-branching-primcall-lowerer* name
+ (lambda (cps kf kt src param args)
+ (match (cons param args)
+ ((param-pat . args-pat)
+ body ...)))))
+
+;; precondition: v is vector. result is u64
+(define-primcall-lowerer (vector-length cps k src #f (v))
+ (with-cps cps
+ (letv w0 ulen)
+ (letk kassume
+ ($kargs ('ulen) (ulen)
+ ($continue k src
+ ($primcall 'assume-u64 `(0 . ,(target-max-vector-length))
(ulen)))))
+ (letk krsh
+ ($kargs ('w0) (w0)
+ ($continue kassume src ($primcall 'ursh/immediate 8 (w0)))))
+ (build-term
+ ($continue krsh src
+ ($primcall 'word-ref/immediate '(vector . 0) (v))))))
+
+;; precondition: v is vector, uidx is u64 in range
+(define-primcall-lowerer (vector-ref cps k src #f (v uidx))
+ (with-cps cps
+ (letv upos)
+ (letk kref ($kargs ('pos) (upos)
+ ($continue k src
+ ($primcall 'scm-ref 'vector (v upos)))))
+ (build-term
+ ($continue kref src
+ ($primcall 'uadd/immediate 1 (uidx))))))
+
+;; precondition: v is vector, idx is in range
+(define-primcall-lowerer (vector-ref/immediate cps k src idx (v))
+ (let ((pos (1+ idx)))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/immediate `(vector . ,pos) (v)))))))
+
+;; precondition: v is vector, uidx is u64 and is in range
+(define-primcall-lowerer (vector-set! cps k src #f (v uidx val))
+ (with-cps cps
+ (letv upos)
+ (letk kset ($kargs ('pos) (upos)
+ ($continue k src
+ ($primcall 'scm-set! 'vector (v upos val)))))
+ (build-term
+ ($continue kset src
+ ($primcall 'uadd/immediate 1 (uidx))))))
+
+;; precondition: v is vector, idx is in range
+(define-primcall-lowerer (vector-set!/immediate cps k src idx (v val))
+ (let ((pos (1+ idx)))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate `(vector . ,pos) (v val)))))))
+
+(define-primcall-lowerer (allocate-vector/immediate cps k src size ())
+ (define nwords (1+ size))
+ (unless (and (exact-integer? size) (<= 0 size (target-max-vector-length)))
+ (error "precondition failed" size))
+ (with-cps cps
+ (letv v w0)
+ (letk kdone
+ ($kargs () ()
+ ($continue k src ($values (v)))))
+ (letk ktag1
+ ($kargs ('w0) (w0)
+ ($continue kdone src
+ ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+ (letk ktag0
+ ($kargs ('v) (v)
+ ($continue ktag1 src
+ ($primcall 'load-u64 (+ %tc7-vector (ash size 8)) ()))))
+ (build-term
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate `(vector . ,nwords) ())))))
+
+;; precondition: usize is u64 within range
+(define-primcall-lowerer (allocate-vector cps k src #f (usize))
+ (with-cps cps
+ (letv nwords v w0-high w0)
+ (letk kdone
+ ($kargs () ()
+ ($continue k src ($values (v)))))
+ (letk ktag2
+ ($kargs ('w0) (w0)
+ ($continue kdone src
+ ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+ (letk ktag1
+ ($kargs ('w0-high) (w0-high)
+ ($continue ktag2 src
+ ($primcall 'uadd/immediate %tc7-vector (w0-high)))))
+ (letk ktag0
+ ($kargs ('v) (v)
+ ($continue ktag1 src
+ ($primcall 'ulsh/immediate 8 (usize)))))
+ (letk kalloc
+ ($kargs ('nwords) (nwords)
+ ($continue ktag0 src
+ ($primcall 'allocate-words 'vector (nwords)))))
+ (build-term
+ ($continue kalloc src
+ ;; Header word.
+ ($primcall 'uadd/immediate 1 (usize))))))
+
+;; precondition: none
+(define-primcall-lowerer (cons cps k src #f (head tail))
+ (with-cps cps
+ (letv pair)
+ (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 head)))))
+ (build-term
+ ($continue khead src
+ ($primcall 'allocate-words/immediate '(pair . 2) ())))))
+
+;; precondition: pair is pair
+(define-primcall-lowerer (car cps k src #f (pair))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/immediate '(pair . 0) (pair))))))
+
+;; precondition: pair is pair
+(define-primcall-lowerer (cdr cps k src #f (pair))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/immediate '(pair . 1) (pair))))))
+
+;; precondition: pair is mutable pair
+(define-primcall-lowerer (set-car! cps k src #f (pair val))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate '(pair . 0) (pair val))))))
+
+;; precondition: pair is mutable pair
+(define-primcall-lowerer (set-cdr! cps k src #f (pair val))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate '(pair . 1) (pair val))))))
+
+;; precondition: none
+(define-primcall-lowerer (box cps k src #f (val))
+ (with-cps cps
+ (letv obj tag)
+ (letk kdone
+ ($kargs () ()
+ ($continue k src ($values (obj)))))
+ (letk kval
+ ($kargs () ()
+ ($continue kdone src
+ ($primcall 'scm-set!/immediate '(box . 1) (obj val)))))
+ (letk ktag1
+ ($kargs ('tag) (tag)
+ ($continue kval src
+ ($primcall 'word-set!/immediate '(box . 0) (obj tag)))))
+ (letk ktag0
+ ($kargs ('obj) (obj)
+ ($continue ktag1 src
+ ($primcall 'load-u64 %tc7-variable ()))))
+ (build-term
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate '(box . 2) ())))))
+
+;; precondition: box is box. note: no checking for unbound!
+(define-primcall-lowerer (box-ref cps k src #f (box))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/immediate '(box . 1) (box))))))
+
+;; precondition: box is box
+(define-primcall-lowerer (box-set! cps k src #f (box val))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate '(box . 1) (box val))))))
+
+;; precondition: struct is a struct.
+(define-primcall-lowerer (struct-vtable cps k src #f (struct))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/tag 'struct (struct))))))
+
+;; precondition: vtable is a vtable. result is u64
+(define-primcall-lowerer (vtable-size cps k src #f (vtable))
+ (define vtable-index-size 5) ; FIXME: pull from struct.h
+ (define vtable-offset-size (1+ vtable-index-size))
+ (with-cps cps
+ (letv rfields)
+ (letk kassume
+ ($kargs ('rfields) (rfields)
+ ($continue k src
+ ($primcall 'assume-u64 `(0 . ,(target-max-size-t/scm))
+ (rfields)))))
+ (build-term
+ ($continue kassume src
+ ($primcall 'word-ref/immediate
+ `(struct . ,vtable-offset-size) (vtable))))))
+
+;; precondition: vtable is a vtable.
+(define-branching-primcall-lowerer (vtable-vtable? cps kf kt src #f (vtable))
+ (define vtable-index-flags 1) ; FIXME: pull from struct.h
+ (define vtable-offset-flags (1+ vtable-index-flags))
+ (define vtable-validated-mask #b11)
+ (define vtable-validated-value #b11)
+ (with-cps cps
+ (letv flags mask res)
+ (letk ktest
+ ($kargs ('res) (res)
+ ($branch kf kt src
+ 'u64-imm-= vtable-validated-value (res))))
+ (letk kand
+ ($kargs ('mask) (mask)
+ ($continue ktest src
+ ($primcall 'ulogand #f (flags mask)))))
+ (letk kflags
+ ($kargs ('flags) (flags)
+ ($continue kand src
+ ($primcall 'load-u64 vtable-validated-mask ()))))
+ (build-term
+ ($continue kflags src
+ ($primcall 'word-ref/immediate
+ `(struct . ,vtable-offset-flags) (vtable))))))
+
+;; precondition: vtable is a vtable.
+(define-branching-primcall-lowerer (vtable-has-unboxed-fields? cps kf kt src
+ nfields
(vtable))
+ (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
+ (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
+ (define (check-any-unboxed cps ptr word)
+ (if (< (* word 32) nfields)
+ (with-cps cps
+ (letv idx bits)
+ (let$ checkboxed (check-any-unboxed ptr (1+ word)))
+ (letk kcheckboxed ($kargs () () ,checkboxed))
+ (letk kcheck
+ ($kargs ('bits) (bits)
+ ($branch kt kcheckboxed src 'u64-imm-= 0 (bits))))
+ (letk kword
+ ($kargs ('idx) (idx)
+ ($continue kcheck src
+ ($primcall 'u32-ref 'bitmask (vtable ptr idx)))))
+ (build-term
+ ($continue kword src
+ ($primcall 'load-u64 word ()))))
+ (with-cps cps
+ (build-term ($continue kf src ($values ()))))))
+ (with-cps cps
+ (letv ptr)
+ (let$ checkboxed (check-any-unboxed ptr 0))
+ (letk kcheckboxed ($kargs ('ptr) (ptr) ,checkboxed))
+ (build-term
+ ($continue kcheckboxed src
+ ($primcall 'pointer-ref/immediate
+ `(struct . ,vtable-offset-unboxed-fields)
+ (vtable))))))
+
+;; precondition: vtable is a vtable, no unboxed fields, nfields matches
+;; vtable size.
+(define-primcall-lowerer (allocate-struct cps k src nfields (vtable))
+ (define nwords (1+ nfields))
+ (with-cps cps
+ (letv s)
+ (letk kdone
+ ($kargs () () ($continue k src ($values (s)))))
+ (letk ktag
+ ($kargs ('s) (s)
+ ($continue kdone src
+ ($primcall 'scm-set!/tag 'struct (s vtable)))))
+ (build-term
+ ($continue ktag src
+ ($primcall 'allocate-words/immediate `(struct . ,nwords) ())))))
+
+;; precondition: vtable is vtable, idx less than vtable size
+(define-branching-primcall-lowerer (vtable-field-boxed? cps kf kt src idx
(vtable))
+ (define vtable-index-unboxed-fields 6) ; FIXME: pull from struct.h
+ (define vtable-offset-unboxed-fields (1+ vtable-index-unboxed-fields))
+ (with-cps cps
+ (letv ptr word bits mask res)
+ (letk ktest
+ ($kargs ('res) (res)
+ ($branch kf kt src 'u64-imm-= 0 (res))))
+ (letk kand
+ ($kargs ('mask) (mask)
+ ($continue ktest src
+ ($primcall 'ulogand #f (mask bits)))))
+ (letk kbits
+ ($kargs ('bits) (bits)
+ ($continue kand src
+ ($primcall 'load-u64 (ash 1 (logand idx 31)) ()))))
+ (letk kword
+ ($kargs ('word) (word)
+ ($continue kbits src
+ ($primcall 'u32-ref 'bitmask (vtable ptr word)))))
+ (letk kptr
+ ($kargs ('ptr) (ptr)
+ ($continue kword src
+ ($primcall 'load-u64 (ash idx -5) ()))))
+ (build-term
+ ($continue kptr src
+ ($primcall 'pointer-ref/immediate
+ `(struct . ,vtable-offset-unboxed-fields)
+ (vtable))))))
+
+;; precondition: struct a struct, idx in range, field unboxed.
+(define-primcall-lowerer (struct-ref cps k src idx (struct))
+ (define pos (1+ idx)) ; get past vtable
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-ref/immediate `(struct . ,pos) (struct))))))
+
+;; precondition: struct a struct, idx in range, field unboxed.
+(define-primcall-lowerer (struct-set! cps k src idx (struct val))
+ (define pos (1+ idx)) ; get past vtable
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate `(struct . ,pos) (struct val))))))
+
+;; precondition: bv is bytevector. result is ptr
+(define-primcall-lowerer (bv-contents cps k src #f (bv))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'pointer-ref/immediate '(bytevector . 2) (bv))))))
+
+;; precondition: bv is bytevector. result u64
+(define-primcall-lowerer (bv-length cps k src #f (bv))
+ (with-cps cps
+ (letv ulen)
+ (letk kassume
+ ($kargs ('ulen) (ulen)
+ ($continue k src
+ ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
+ (build-term
+ ($continue kassume src
+ ($primcall 'word-ref/immediate '(bytevector . 1) (bv))))))
+
+;; precondition: str is a string. result u64
+(define-primcall-lowerer (string-length cps k src #f (str))
+ (with-cps cps
+ (letv ulen)
+ (letk kassume
+ ($kargs ('ulen) (ulen)
+ ($continue k src
+ ($primcall 'assume-u64 `(0 . ,(target-max-size-t)) (ulen)))))
+ (build-term
+ ($continue kassume src
+ ($primcall 'word-ref/immediate '(string . 3) (str))))))
+
+;; precondition: s a string, uidx in range. result unboxed.
+(define-primcall-lowerer (string-ref cps k src #f (s uidx))
+ (define stringbuf-f-wide #x400)
+ (with-cps cps
+ (letv start upos buf ptr tag mask bits uwpos u32)
+ (letk kassume
+ ($kargs ('u32) (u32)
+ ($continue k src
+ ($primcall 'assume-u64 '(0 . #xffffff) (u32)))))
+ (letk kwideref
+ ($kargs ('uwpos) (uwpos)
+ ($continue kassume src
+ ($primcall 'u32-ref 'stringbuf (buf ptr uwpos)))))
+ (letk kwide
+ ($kargs () ()
+ ($continue kwideref src
+ ($primcall 'ulsh/immediate 2 (upos)))))
+ (letk knarrow
+ ($kargs () ()
+ ($continue k src
+ ($primcall 'u8-ref 'stringbuf (buf ptr upos)))))
+ (letk kcmp
+ ($kargs ('bits) (bits)
+ ($branch kwide knarrow src 'u64-imm-= 0 (bits))))
+ (letk kmask
+ ($kargs ('mask) (mask)
+ ($continue kcmp src
+ ($primcall 'ulogand #f (tag mask)))))
+ (letk ktag
+ ($kargs ('tag) (tag)
+ ($continue kmask src
+ ($primcall 'load-u64 stringbuf-f-wide ()))))
+ (letk kptr
+ ($kargs ('ptr) (ptr)
+ ($continue ktag src
+ ($primcall 'word-ref/immediate '(stringbuf . 0) (buf)))))
+ (letk kwidth
+ ($kargs ('buf) (buf)
+ ($continue kptr src
+ ($primcall 'tail-pointer-ref/immediate '(stringbuf . 2) (buf)))))
+ (letk kbuf
+ ($kargs ('upos) (upos)
+ ($continue kwidth src
+ ($primcall 'scm-ref/immediate '(string . 1) (s)))))
+ (letk kadd
+ ($kargs ('start) (start)
+ ($continue kbuf src
+ ($primcall 'uadd #f (start uidx)))))
+ (build-term
+ ($continue kadd src
+ ($primcall 'word-ref/immediate '(string . 2) (s))))))
+
+;; precondition: none.
+(define-primcall-lowerer (make-atomic-box cps k src #f (val))
+ (with-cps cps
+ (letv obj tag)
+ (letk kdone
+ ($kargs () ()
+ ($continue k src ($values (obj)))))
+ (letk kval
+ ($kargs () ()
+ ($continue kdone src
+ ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1) (obj
val)))))
+ (letk ktag1
+ ($kargs ('tag) (tag)
+ ($continue kval src
+ ($primcall 'word-set!/immediate '(atomic-box . 0) (obj tag)))))
+ (letk ktag0
+ ($kargs ('obj) (obj)
+ ($continue ktag1 src
+ ($primcall 'load-u64 %tc7-atomic-box ()))))
+ (build-term
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate '(atomic-box . 2) ())))))
+
+;; precondition: x is atomic box
+(define-primcall-lowerer (atomic-box-ref cps k src #f (x))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'atomic-scm-ref/immediate '(atomic-box . 1) (x))))))
+
+;; precondition: x is atomic box
+(define-primcall-lowerer (atomic-box-set! cps k src #f (x val))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'atomic-scm-set!/immediate '(atomic-box . 1)
+ (x val))))))
+
+;; precondition: x is atomic box
+(define-primcall-lowerer (atomic-box-swap! cps k src param (x val))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'atomic-scm-swap!/immediate '(atomic-box . 1)
+ (x val))))))
+
+;; precondition: x is atomic box
+(define-primcall-lowerer (atomic-box-compare-and-swap! cps k src param (x
expected desired))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'atomic-scm-compare-and-swap!/immediate '(atomic-box . 1)
+ (x expected desired))))))
+
+;; precondition: code is result of $code
+(define-primcall-lowerer (make-closure cps k src nfree (code))
+ (define nwords (+ nfree 2))
+ (with-cps cps
+ (letv closure tag)
+ (letk kdone
+ ($kargs () ()
+ ($continue k src ($values (closure)))))
+ (letk kinit
+ ($kargs () ()
+ ($continue kdone src
+ ($primcall 'word-set!/immediate '(closure . 1) (closure code)))))
+ (letk ktag1
+ ($kargs ('tag) (tag)
+ ($continue kinit src
+ ($primcall 'word-set!/immediate '(closure . 0) (closure tag)))))
+ (letk ktag0
+ ($kargs ('closure) (closure)
+ ($continue ktag1 src
+ ($primcall 'load-u64 (+ %tc7-program (ash nfree 16)) ()))))
+
+ (build-term
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate `(closure . ,nwords) ())))))
+
+;; precondition: closure is closure, idx is in range
+(define-primcall-lowerer (closure-ref cps k src idx (closure))
+ (let ((pos (+ idx 2)))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($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))
+ (let ((pos (+ idx 2)))
+ (with-cps cps
+ (build-term
+ ($continue k src
+ ($primcall 'scm-set!/immediate `(closure . ,pos) (closure val)))))))
+
+(define (lower-primcalls cps)
+ (with-fresh-name-state cps
+ (persistent-intmap
+ (intmap-fold
+ (lambda (label cont cps)
+ (match cont
+ (($ $kargs names vars
+ ($ $continue k src ($ $primcall op param args)))
+ (match (hashq-ref *primcall-lowerers* op)
+ (#f cps)
+ (lower
+ (with-cps cps
+ (let$ term (lower k src param args))
+ (setk label ($kargs names vars ,term))))))
+ (($ $kargs names vars
+ ($ $branch kf kt src op param args))
+ (match (hashq-ref *branching-primcall-lowerers* op)
+ (#f cps)
+ (lower
+ (with-cps cps
+ (let$ term (lower kf kt src param args))
+ (setk label ($kargs names vars ,term))))))
+ (_ cps)))
+ cps cps))))
- [Guile-commits] branch main updated (aa2cfe7cf -> 85f85a0fc), Andy Wingo, 2023/06/22
- [Guile-commits] 04/19: Move f64->scm lowering to lower-primcalls, Andy Wingo, 2023/06/22
- [Guile-commits] 05/19: Add support for higher-level object representations in type analysis, Andy Wingo, 2023/06/22
- [Guile-commits] 03/19: Wire in lower-primitives pass, Andy Wingo, 2023/06/22
- [Guile-commits] 07/19: Fix effects analysis bug for synthesized definitions at allocations, Andy Wingo, 2023/06/22
- [Guile-commits] 02/19: New CPS pass: lower-primcalls,
Andy Wingo <=
- [Guile-commits] 06/19: Add effects analysis for new high-level object accessors, Andy Wingo, 2023/06/22
- [Guile-commits] 08/19: Add CSE auxiliary definitions for cons, set-car! etc, Andy Wingo, 2023/06/22
- [Guile-commits] 16/19: Tree-IL-to-CPS lowers to high-level object reprs: structs, Andy Wingo, 2023/06/22
- [Guile-commits] 13/19: Tree-IL-to-CPS lowers to high-level object representations: boxes, Andy Wingo, 2023/06/22
- [Guile-commits] 15/19: Tree-IL-to-CPS lowers to high-level object reprs: pairs, Andy Wingo, 2023/06/22
- [Guile-commits] 18/19: Tree-IL-to-CPS lowers to high-level object reprs: strings, Andy Wingo, 2023/06/22
- [Guile-commits] 19/19: Tree-IL-to-CPS lowers to high-level object reprs: vectors, Andy Wingo, 2023/06/22
- [Guile-commits] 01/19: Fix target-max-size-t/scm to not be a fraction (oops), Andy Wingo, 2023/06/22
- [Guile-commits] 09/19: Remove useless code in CSE, Andy Wingo, 2023/06/22
- [Guile-commits] 12/19: Closure conversion produces high-level object representations, Andy Wingo, 2023/06/22