mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

Enable CPS2 closure conversion

Browse source 
* module/language/cps2/closure-conversion.scm: Remove debug printfs.
* module/language/cps2/compile-cps.scm (compile-cps):
* module/language/cps/compile-bytecode.scm (compile-bytecode): Use CPS2
  closure conversion by default.
This commit is contained in:
Andy Wingo 2015-07-15 16:44:49 +02:00
parent 6cfb7afb61
commit 030e9b7603
3 changed files with 2 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/language/cps/compile-bytecode.scm
View file

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

3
module/language/cps2/closure-conversion.scm
View file

@ -201,7 +201,6 @@ the bound vars of the closure."
((eq? empty-intset unknown-kfuns) ((eq? empty-intset unknown-kfuns)
;; All functions are well-known; we can share a closure. Use ;; All functions are well-known; we can share a closure. Use
;; the first bound variable. ;; the first bound variable.
(pk 'all-well-known kfuns)
(let ((closure (car vars))) (let ((closure (car vars)))
(intset-fold (lambda (kfun out) (intset-fold (lambda (kfun out)
(intmap-add out kfun closure)) (intmap-add out kfun closure))
@ -211,7 +210,6 @@ the bound vars of the closure."
;; Only one function is not-well-known. Use that ;; Only one function is not-well-known. Use that
;; function's closure as the shared closure. ;; function's closure as the shared closure.
(let ((closure (assq-ref (map cons kfuns vars) unknown-kfun))) (let ((closure (assq-ref (map cons kfuns vars) unknown-kfun)))
(pk 'one-not-well-known kfuns closure)
(intset-fold (lambda (kfun out) (intset-fold (lambda (kfun out)
(intmap-add out kfun closure)) (intmap-add out kfun closure))
kfuns-set out)))) kfuns-set out))))
@ -789,7 +787,6 @@ bound to @var{var}, and continue to @var{k}."
($continue k src ($continue k src
($prompt escape? tag handler))))))))) ($prompt escape? tag handler)))))))))
(pk 'convert-one label body free self-known?)
(intset-fold (lambda (label cps) (intset-fold (lambda (label cps)
(match (intmap-ref cps label (lambda (_) #f)) (match (intmap-ref cps label (lambda (_) #f))
(($ $kargs names vars term) (($ $kargs names vars term)

2
module/language/cps2/compile-cps.scm
View file

@ -118,6 +118,6 @@
(define (compile-cps exp env opts) (define (compile-cps exp env opts)
(let ((exp (optimize-higher-order-cps exp opts))) (let ((exp (optimize-higher-order-cps exp opts)))
(if (kw-arg-ref opts #:cps2-convert? #f) (if (kw-arg-ref opts #:cps2-convert? #t)
(values (conts->fun* (renumber (convert-closures exp))) env env) (values (conts->fun* (renumber (convert-closures exp))) env env)
(values (conts->fun (renumber exp)) env env)))) (values (conts->fun (renumber exp)) env env))))