FM / cps

/usr/share/guile/3.0/language/cps

Name	Size	Mode	Actions
closure-conversion.scm	38159	0644	edit dl rm
compile-bytecode.scm	32866	0644	edit dl rm
contification.scm	23824	0644	edit dl rm
cse.scm	33392	0644	edit dl rm
dce.scm	18456	0644	edit dl rm
devirtualize-integers.scm	11605	0644	edit dl rm
effects-analysis.scm	25138	0644	edit dl rm
elide-arity-checks.scm	4520	0644	edit dl rm
graphs.scm	10401	0644	edit dl rm
intmap.scm	29027	0644	edit dl rm
intset.scm	30298	0644	edit dl rm
licm.scm	15049	0644	edit dl rm
loop-instrumentation.scm	2613	0644	edit dl rm
optimize.scm	5730	0644	edit dl rm
peel-loops.scm	14868	0644	edit dl rm
prune-top-level-scopes.scm	2121	0644	edit dl rm
reify-primitives.scm	25205	0644	edit dl rm
renumber.scm	10457	0644	edit dl rm
rotate-loops.scm	10686	0644	edit dl rm
self-references.scm	3130	0644	edit dl rm
simplify.scm	10773	0644	edit dl rm
slot-allocation.scm	41846	0644	edit dl rm
spec.scm	1875	0644	edit dl rm
specialize-numbers.scm	44495	0644	edit dl rm
specialize-primcalls.scm	6871	0644	edit dl rm
split-rec.scm	7739	0644	edit dl rm
switch.scm	18438	0644	edit dl rm
type-checks.scm	3146	0644	edit dl rm
type-fold.scm	29158	0644	edit dl rm
types.scm	82504	0644	edit dl rm
utils.scm	14004	0644	edit dl rm
verify.scm	12703	0644	edit dl rm
with-cps.scm	5856	0644	edit dl rm

Edit: /usr/share/guile/3.0/language/cps/optimize.scm (5730B)

;;; Continuation-passing style (CPS) intermediate language (IL)

;;; 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:
;;;
;;; Optimizations on CPS.
;;;
;;; Code:

(define-module (language cps optimize)
  #:use-module (ice-9 match)
  #:use-module (language cps closure-conversion)
  #:use-module (language cps contification)
  #:use-module (language cps cse)
  #:use-module (language cps dce)
  #:use-module (language cps devirtualize-integers)
  #:use-module (language cps elide-arity-checks)
  #:use-module (language cps licm)
  #:use-module (language cps loop-instrumentation)
  #:use-module (language cps peel-loops)
  #:use-module (language cps prune-top-level-scopes)
  #:use-module (language cps reify-primitives)
  #:use-module (language cps renumber)
  #:use-module (language cps rotate-loops)
  #:use-module (language cps self-references)
  #:use-module (language cps simplify)
  #:use-module (language cps specialize-numbers)
  #:use-module (language cps specialize-primcalls)
  #:use-module (language cps split-rec)
  #:use-module (language cps switch)
  #:use-module (language cps type-fold)
  #:use-module (language cps verify)
  #:use-module (system base optimize)
  #:export (optimize-higher-order-cps
            optimize-first-order-cps
            cps-optimizations
            make-cps-lowerer))

(define *debug?* #f)

(define (maybe-verify program)
  (if *debug?*
      (verify program)
      program))

(define-syntax-rule (define-optimizer optimize (pass kw) ...)
  (define* (optimize program #:optional (opts '()))
    ;; This series of assignments to `program' used to be a series of
    ;; let* bindings of `program', as you would imagine.  In compiled
    ;; code this is fine because the compiler is able to allocate all
    ;; let*-bound variable to the same slot, which also means that the
    ;; garbage collector doesn't have to retain so many copies of the
    ;; term being optimized.  However during bootstrap, the interpreter
    ;; doesn't do this optimization, leading to excessive data retention
    ;; as the terms are rewritten.  To marginally improve bootstrap
    ;; memory usage, here we use set! instead.  The compiler should
    ;; produce the same code in any case, though currently it does not
    ;; because it doesn't do escape analysis on the box created for the
    ;; set!.
    (maybe-verify program)
    (set! program
      (if (assq-ref opts kw)
          (maybe-verify (pass program))
          program))
    ...
    (maybe-verify program)))

;; Passes that are needed:
;;
;;  * Abort contification: turning abort primcalls into continuation
;;    calls, and eliding prompts if possible.
;;
(define-optimizer optimize-higher-order-cps
  ;; FIXME: split-rec call temporarily moved to compile-bytecode and run
  ;; unconditionally, because closure conversion requires it.  Move the
  ;; pass back here when that's fixed.
  ;;
  ;; (split-rec #:split-rec?)
  (eliminate-dead-code #:eliminate-dead-code?)
  (prune-top-level-scopes #:prune-top-level-scopes?)
  (simplify #:simplify?)
  (contify #:contify?)
  (simplify #:simplify?)
  (devirtualize-integers #:devirtualize-integers?)
  (peel-loops #:peel-loops?)
  (eliminate-common-subexpressions #:cse?)
  (type-fold #:type-fold?)
  (resolve-self-references #:resolve-self-references?)
  (eliminate-dead-code #:eliminate-dead-code?)
  (simplify #:simplify?))

(define-optimizer optimize-first-order-cps
  (elide-arity-checks #:elide-arity-checks?)
  (specialize-numbers #:specialize-numbers?)
  (hoist-loop-invariant-code #:licm?)
  (specialize-primcalls #:specialize-primcalls?)
  (optimize-branch-chains #:optimize-branch-chains?)
  (eliminate-common-subexpressions #:cse?)
  (eliminate-dead-code #:eliminate-dead-code?)
  ;; Running simplify here enables rotate-loops to do a better job.
  (simplify #:simplify?)
  (rotate-loops #:rotate-loops?)
  (simplify #:simplify?))

(define (cps-optimizations)
  (available-optimizations 'cps))

(define (lower-cps exp opts)
  ;; FIXME: For now the closure conversion pass relies on $rec instances
  ;; being separated into SCCs.  We should fix this to not be the case,
  ;; and instead move the split-rec pass back to
  ;; optimize-higher-order-cps.
  (set! exp (split-rec exp))
  (set! exp (optimize-higher-order-cps exp opts))
  (set! exp (convert-closures exp))
  (set! exp (optimize-first-order-cps exp opts))
  (set! exp (reify-primitives exp))
  (set! exp (add-loop-instrumentation exp))
  (renumber exp))

(define (make-cps-lowerer optimization-level opts)
  (define (kw-arg-ref args kw default)
    (match (memq kw args)
      ((_ val . _) val)
      (_ default)))
  (define (enabled-for-level? level) (<= level optimization-level))
  (let ((opts (let lp ((all-opts (cps-optimizations)))
                (match all-opts
                  (() '())
                  (((kw level) . all-opts)
                   (acons kw (kw-arg-ref opts kw (enabled-for-level? level))
                          (lp all-opts)))))))
    (lambda (exp env)
      (lower-cps exp opts))))

cmd: