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

Add ,optimize-cps REPL meta-command

Browse source 
* module/system/repl/command.scm (*command-table*): Add optimize-cps /
optx.
(optimize-cps): Define meta-command.
* module/system/repl/common.scm (optimize*): New helper.
(repl-optimize): Use helper.
(repl-optimize-cps): New public function.
This commit is contained in:
Andy Wingo 2021-06-17 21:57:26 +02:00
parent 426867ac7d
commit c803566a17
2 changed files with 23 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/system/repl/command.scm
View file

@ -57,7 +57,7 @@
(module (module m) (import use) (load l) (reload re) (binding b) (in)) (module (module m) (import use) (load l) (reload re) (binding b) (in))
(language (language L)) (language (language L))
(compile (compile c) (compile-file cc) (compile (compile c) (compile-file cc)
(expand exp) (optimize opt) (expand exp) (optimize opt) (optimize-cps optx)
(disassemble x) (disassemble-file xx)) (disassemble x) (disassemble-file xx))
(profile (time t) (profile pr) (trace tr)) (profile (time t) (profile pr) (trace tr))
(debug (backtrace bt) (up) (down) (frame fr) (debug (backtrace bt) (up) (down) (frame fr)
@ -490,6 +490,11 @@ Run the optimizer on a piece of code and print the result."
(run-hook before-print-hook x) (run-hook before-print-hook x)
(pp x))) (pp x)))
(define-meta-command (optimize-cps repl (form))
"optimize-cps EXP
Run the CPS optimizer on a piece of code and print the result."
(repl-optimize-cps repl (repl-parse repl form)))
(define-meta-command (disassemble repl (form)) (define-meta-command (disassemble repl (form))
"disassemble EXP "disassemble EXP
Disassemble a compiled procedure." Disassemble a compiled procedure."

26
module/system/repl/common.scm
View file

@ -32,7 +32,7 @@
repl-tm-stats repl-gc-stats repl-debug repl-tm-stats repl-gc-stats repl-debug
repl-welcome repl-prompt repl-welcome repl-prompt
repl-read repl-compile repl-prepare-eval-thunk repl-eval repl-read repl-compile repl-prepare-eval-thunk repl-eval
repl-expand repl-optimize repl-expand repl-optimize repl-optimize-cps
repl-parse repl-print repl-option-ref repl-option-set! repl-parse repl-print repl-option-ref repl-option-set!
repl-default-option-set! repl-default-prompt-set! repl-default-option-set! repl-default-prompt-set!
puts ->string user-error puts ->string user-error
@ -204,7 +204,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
#:env (current-module)) #:env (current-module))
#:from lang #:to from))) #:from lang #:to from)))
(define* (repl-optimize repl form #:key (lang 'tree-il)) (define (optimize* repl form lang print)
(let ((from (repl-language repl)) (let ((from (repl-language repl))
(make-lower (language-lowerer (lookup-language lang))) (make-lower (language-lowerer (lookup-language lang)))
(optimization-level (repl-optimization-level repl)) (optimization-level (repl-optimization-level repl))
@ -212,13 +212,21 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(opts (repl-compile-options repl))) (opts (repl-compile-options repl)))
(unless make-lower (unless make-lower
(error "language has no optimizer" lang)) (error "language has no optimizer" lang))
(decompile ((make-lower optimization-level opts) (print ((make-lower optimization-level opts)
(compile form #:from from #:to lang #:opts opts (compile form #:from from #:to lang #:opts opts
#:optimization-level optimization-level #:optimization-level optimization-level
#:warning-level warning-level #:warning-level warning-level
#:env (current-module)) #:env (current-module))
(current-module)) (current-module)))))
#:from lang #:to from)))
(define* (repl-optimize repl form #:key (lang 'tree-il))
(optimize* repl form lang
(lambda (exp)
(decompile exp #:from lang #:to (repl-language repl)))))
(define* (repl-optimize-cps repl form)
(optimize* repl form 'cps
(module-ref (resolve-interface '(language cps dump)) 'dump)))
(define (repl-parse repl form) (define (repl-parse repl form)
(let ((parser (language-parser (repl-language repl)))) (let ((parser (language-parser (repl-language repl))))