optimize.scm 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. ;;; Continuation-passing style (CPS) intermediate language (IL)
  2. ;; Copyright (C) 2013-2018,2020,2021,2023 Free Software Foundation, Inc.
  3. ;;; This library is free software; you can redistribute it and/or modify it
  4. ;;; under the terms of the GNU Lesser General Public License as published by
  5. ;;; the Free Software Foundation; either version 3 of the License, or (at
  6. ;;; your option) any later version.
  7. ;;;
  8. ;;; This library is distributed in the hope that it will be useful, but
  9. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
  11. ;;; General Public License for more details.
  12. ;;;
  13. ;;; You should have received a copy of the GNU Lesser General Public License
  14. ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;;
  17. ;;; Optimizations on CPS.
  18. ;;;
  19. ;;; Code:
  20. (define-module (language cps optimize)
  21. #:use-module (ice-9 match)
  22. #:use-module (language cps closure-conversion)
  23. #:use-module (language cps contification)
  24. #:use-module (language cps cse)
  25. #:use-module (language cps dce)
  26. #:use-module (language cps devirtualize-integers)
  27. #:use-module (language cps elide-arity-checks)
  28. #:use-module (language cps licm)
  29. #:use-module (language cps peel-loops)
  30. #:use-module (language cps prune-top-level-scopes)
  31. #:use-module (language cps renumber)
  32. #:use-module (language cps rotate-loops)
  33. #:use-module (language cps return-types)
  34. #:use-module (language cps self-references)
  35. #:use-module (language cps simplify)
  36. #:use-module (language cps specialize-numbers)
  37. #:use-module (language cps specialize-primcalls)
  38. #:use-module (language cps split-rec)
  39. #:use-module (language cps switch)
  40. #:use-module (language cps type-fold)
  41. #:use-module (language cps verify)
  42. #:use-module (system base optimize)
  43. #:use-module (system base target)
  44. #:export (optimize-higher-order-cps
  45. optimize-first-order-cps
  46. cps-optimizations
  47. make-cps-lowerer))
  48. (define *debug?* #f)
  49. (define (maybe-verify program)
  50. (if *debug?*
  51. (verify program)
  52. program))
  53. (define-syntax-rule (define-optimizer optimize (pass kw) ...)
  54. (define* (optimize program #:optional (opts '()))
  55. ;; This series of assignments to `program' used to be a series of
  56. ;; let* bindings of `program', as you would imagine. In compiled
  57. ;; code this is fine because the compiler is able to allocate all
  58. ;; let*-bound variable to the same slot, which also means that the
  59. ;; garbage collector doesn't have to retain so many copies of the
  60. ;; term being optimized. However during bootstrap, the interpreter
  61. ;; doesn't do this optimization, leading to excessive data retention
  62. ;; as the terms are rewritten. To marginally improve bootstrap
  63. ;; memory usage, here we use set! instead. The compiler should
  64. ;; produce the same code in any case, though currently it does not
  65. ;; because it doesn't do escape analysis on the box created for the
  66. ;; set!.
  67. (maybe-verify program)
  68. (set! program
  69. (if (assq-ref opts kw)
  70. (maybe-verify (pass program))
  71. program))
  72. ...
  73. (maybe-verify program)))
  74. ;; Passes that are needed:
  75. ;;
  76. ;; * Abort contification: turning abort primcalls into continuation
  77. ;; calls, and eliding prompts if possible.
  78. ;;
  79. (define-optimizer optimize-higher-order-cps
  80. ;; FIXME: split-rec call temporarily moved to compile-bytecode and run
  81. ;; unconditionally, because closure conversion requires it. Move the
  82. ;; pass back here when that's fixed.
  83. ;;
  84. ;; (split-rec #:split-rec?)
  85. (eliminate-dead-code #:eliminate-dead-code?)
  86. (prune-top-level-scopes #:prune-top-level-scopes?)
  87. (simplify #:simplify?)
  88. (contify #:contify?)
  89. (simplify #:simplify?)
  90. (devirtualize-integers #:devirtualize-integers?)
  91. (peel-loops #:peel-loops?)
  92. (eliminate-common-subexpressions #:cse?)
  93. (type-fold #:type-fold?)
  94. (resolve-self-references #:resolve-self-references?)
  95. (eliminate-dead-code #:eliminate-dead-code?)
  96. (simplify #:simplify?))
  97. (define-optimizer optimize-first-order-cps
  98. (elide-arity-checks #:elide-arity-checks?)
  99. (specialize-numbers #:specialize-numbers?)
  100. (hoist-loop-invariant-code #:licm?)
  101. (specialize-primcalls #:specialize-primcalls?)
  102. (optimize-branch-chains #:optimize-branch-chains?)
  103. (eliminate-common-subexpressions #:cse?)
  104. (optimize-known-return-types #:optimize-known-return-types?)
  105. (eliminate-dead-code #:eliminate-dead-code?)
  106. ;; Running simplify here enables rotate-loops to do a better job.
  107. (simplify #:simplify?)
  108. (rotate-loops #:rotate-loops?)
  109. (simplify #:simplify?))
  110. (define (cps-optimizations)
  111. (available-optimizations 'cps))
  112. (define (make-backend-cps-lowerer optimization-level opts)
  113. (let* ((iface (resolve-interface `(language cps ,(target-runtime))))
  114. (make-lowerer (module-ref iface 'make-lowerer)))
  115. (make-lowerer optimization-level opts)))
  116. (define (lower-cps/generic exp opts)
  117. ;; FIXME: For now the closure conversion pass relies on $rec instances
  118. ;; being separated into SCCs. We should fix this to not be the case,
  119. ;; and instead move the split-rec pass back to
  120. ;; optimize-higher-order-cps.
  121. (set! exp (split-rec exp))
  122. (set! exp (optimize-higher-order-cps exp opts))
  123. (set! exp (convert-closures exp))
  124. (optimize-first-order-cps exp opts))
  125. (define (select-optimizations optimization-level opts all-opts)
  126. (define (kw-arg-ref args kw default)
  127. (match (memq kw args)
  128. ((_ val . _) val)
  129. (_ default)))
  130. (define (enabled-for-level? level) (<= level optimization-level))
  131. (let lp ((all-opts all-opts))
  132. (match all-opts
  133. (() '())
  134. (((kw level) . all-opts)
  135. (acons kw (kw-arg-ref opts kw (enabled-for-level? level))
  136. (lp all-opts))))))
  137. (define (make-cps-lowerer optimization-level opts)
  138. (define generic-opts
  139. (select-optimizations optimization-level opts (cps-optimizations)))
  140. (define lower-cps/backend
  141. (make-backend-cps-lowerer optimization-level opts))
  142. (lambda (exp env)
  143. (renumber
  144. (lower-cps/backend
  145. (lower-cps/generic exp generic-opts)
  146. env))))