mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 02:00:20 +02:00
Code Activity

Compile-time debugging

Browse source 
* module/language/cps/compile-rtl.scm:
* module/language/cps/contification.scm: Add some compile-time
  printouts.  Will be removed later.
This commit is contained in:
Andy Wingo 2013-10-27 20:10:59 +01:00
parent 334bd8e3c1
commit 6a37b7faaf
2 changed files with 9 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/cps/compile-rtl.scm
View file

@ -50,7 +50,9 @@
(define (optimize exp opts) (define (optimize exp opts)
(define (run-pass exp pass kw default) (define (run-pass exp pass kw default)
(if (kw-arg-ref opts kw default) (if (kw-arg-ref opts kw default)
(pass exp) (begin
(pk 'OPTIMIZING kw)
(pass exp))
exp)) exp))
;; Calls to source-to-source optimization passes go here. ;; Calls to source-to-source optimization passes go here.
@ -433,11 +435,13 @@
(emit-end-program asm))))) (emit-end-program asm)))))
(define (compile-rtl exp env opts) (define (compile-rtl exp env opts)
(pk 'COMPILING)
(let* ((exp (fix-arities exp)) (let* ((exp (fix-arities exp))
(exp (optimize exp opts)) (exp (optimize exp opts))
(exp (convert-closures exp)) (exp (convert-closures exp))
(exp (reify-primitives exp)) (exp (reify-primitives exp))
(asm (make-assembler))) (asm (make-assembler)))
(pk 'CODEGEN)
(visit-funs (lambda (fun) (visit-funs (lambda (fun)
(compile-fun fun asm)) (compile-fun fun asm))
exp) exp)

6
module/language/cps/contification.scm
View file

@ -345,5 +345,7 @@
(if (null? call-substs) (if (null? call-substs)
fun fun
;; Iterate to fixed point. ;; Iterate to fixed point.
(contify (begin
(apply-contification fun call-substs cont-substs fun-elisions cont-splices)))))) (pk 'CONTIFIED (length call-substs))
(contify
(apply-contification fun call-substs cont-substs fun-elisions cont-splices)))))))