1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00

Add compiler support for eliding closure bindings

* module/language/cps/closure-conversion.scm (compute-elidable-closures):
  New function.
  (convert-one, convert-closures): Add ability to set "self" variable of
  $kfun to $f, hopefully avoiding passing that argument in some cases.
* module/language/cps/compile-bytecode.scm (compile-function): Pass the
  has-closure? bit on through to the assembler.
* module/system/vm/assembler.scm (begin-standard-arity)
  (begin-opt-arity, begin-kw-arity): Only reserve space for the closure
  as appropriate.
* module/language/cps/slot-allocation.scm (allocate-args)
  (compute-defs-and-uses, compute-needs-slot)
  (compute-var-representations): Allow for closure slot allocation
  differences.
* module/language/cps/cse.scm (compute-defs):
* module/language/cps/dce.scm (compute-live-code):
* module/language/cps/renumber.scm (renumber, compute-renaming):
(allocate-args):
* module/language/cps/specialize-numbers.scm (compute-significant-bits):
(compute-defs):
* module/language/cps/split-rec.scm (compute-free-vars):
* module/language/cps/types.scm (infer-types):
* module/language/cps/utils.scm (compute-max-label-and-var):
* module/language/cps/verify.scm (check-distinct-vars):
(compute-available-definitions): Allow closure to be #f.
This commit is contained in:
Andy Wingo 2019-06-07 15:37:20 +02:00
parent f07fadc72e
commit f6c07e4eb2
12 changed files with 131 additions and 57 deletions

View file

@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
;; Copyright (C) 2013-2019 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
@ -624,6 +624,8 @@
(let ((first? (match (intmap-ref cps (1- label))
(($ $kfun) #t)
(_ #f)))
(has-closure? (match (intmap-ref cps (intmap-next cps))
(($ $kfun src meta self tail) (->bool self))))
(kw-indices (map (match-lambda
((key name sym)
(cons key (lookup-slot sym allocation))))
@ -631,10 +633,11 @@
(unless first?
(emit-end-arity asm))
(emit-label asm label)
(emit-begin-kw-arity asm req opt rest kw-indices allow-other-keys?
frame-size alt)
;; All arities define a closure binding in slot 0.
(emit-definition asm 'closure 0 'scm)
(emit-begin-kw-arity asm has-closure? req opt rest kw-indices
allow-other-keys? frame-size alt)
(when has-closure?
;; Most arities define a closure binding in slot 0.
(emit-definition asm 'closure 0 'scm))
;; Usually we just fall through, but it could be the body is
;; contified into another clause.
(let ((body (forward-label body)))