1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00

Wire up new closure conversion pass

* module/language/cps/compile-bytecode.scm (compile-bytecode): Only
  convert closures if the #:cps2-convert? option is not passed.

* module/language/cps2/compile-cps.scm (conts->fun*, compile-cps): Add
  support for CPS2 closure conversion, disabled by default.
This commit is contained in:
Andy Wingo 2015-07-15 09:43:33 +02:00
parent 285f62a077
commit 981802c4c2
2 changed files with 26 additions and 5 deletions

View file

@ -517,7 +517,9 @@
;;
;; (set! exp (optimize exp opts))
(set! exp (convert-closures exp))
(set! exp (if (not (kw-arg-ref opts #:cps2-convert? #f))
(convert-closures exp)
exp))
;; first-order optimization should go here
(set! exp (reify-primitives exp))
(set! exp (renumber exp))

View file

@ -27,6 +27,7 @@
#:use-module (language cps2)
#:use-module ((language cps) #:prefix cps:)
#:use-module (language cps2 utils)
#:use-module (language cps2 closure-conversion)
#:use-module (language cps2 optimize)
#:use-module (language cps2 renumber)
#:use-module (language cps intmap)
@ -34,7 +35,7 @@
;; Precondition: For each function in CONTS, the continuation names are
;; topologically sorted.
(define (conts->fun conts)
(define* (conts->fun conts #:optional (kfun 0))
(define (convert-fun kfun)
(let ((doms (compute-dom-edges (compute-idoms conts kfun))))
(define (visit-cont label)
@ -97,8 +98,26 @@
(($ $kfun src meta self tail clause)
(kfun (cps:$kfun src meta self (tail (cps:$ktail))
,(visit-clause clause)))))))
(convert-fun 0))
(convert-fun kfun))
(define (conts->fun* conts)
(cps:build-cps-term
(cps:$program
,(intmap-fold-right (lambda (label cont out)
(match cont
(($ $kfun)
(cons (conts->fun conts label) out))
(_ out)))
conts
'()))))
(define (kw-arg-ref args kw default)
(match (memq kw args)
((_ val . _) val)
(_ default)))
(define (compile-cps exp env opts)
(let ((exp (renumber (optimize-higher-order-cps exp opts))))
(values (conts->fun exp) env env)))
(let ((exp (optimize-higher-order-cps exp opts)))
(if (kw-arg-ref opts #:cps2-convert? #f)
(values (conts->fun* (renumber (convert-closures exp))) env env)
(values (conts->fun (renumber exp)) env env))))