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))
(language (language L))
(compile (compile c) (compile-file cc)
(expand exp) (optimize opt)
(expand exp) (optimize opt) (optimize-cps optx)
(disassemble x) (disassemble-file xx))
(profile (time t) (profile pr) (trace tr))
(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)
(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))
"disassemble EXP
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-welcome repl-prompt
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-default-option-set! repl-default-prompt-set!
puts ->string user-error
@ -204,7 +204,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
#:env (current-module))
#:from lang #:to from)))
(define* (repl-optimize repl form #:key (lang 'tree-il))
(define (optimize* repl form lang print)
(let ((from (repl-language repl))
(make-lower (language-lowerer (lookup-language lang)))
(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)))
(unless make-lower
(error "language has no optimizer" lang))
(decompile ((make-lower optimization-level opts)
(compile form #:from from #:to lang #:opts opts
#:optimization-level optimization-level
#:warning-level warning-level
#:env (current-module))
(current-module))
#:from lang #:to from)))
(print ((make-lower optimization-level opts)
(compile form #:from from #:to lang #:opts opts
#:optimization-level optimization-level
#:warning-level warning-level
#:env (current-module))
(current-module)))))
(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)
(let ((parser (language-parser (repl-language repl))))