diff options
| author | Andy Wingo <wingo@pobox.com> | 2021-06-17 21:57:26 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2021-10-01 11:33:13 +0200 |
| commit | c803566a17b513dc63c4e1d282c4b9a89c17903e (patch) | |
| tree | 4f493972a17527649a3c87983d8ffc66a232645e /module/system | |
| parent | 426867ac7de8281cd5d8be1e152c7c04835782e9 (diff) | |
| download | guile-c803566a17b513dc63c4e1d282c4b9a89c17903e.tar.gz | |
Add ,optimize-cps REPL meta-command
* 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.
Diffstat (limited to 'module/system')
| -rw-r--r-- | module/system/repl/command.scm | 7 | ||||
| -rw-r--r-- | module/system/repl/common.scm | 26 |
2 files changed, 23 insertions, 10 deletions
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index fce3a2471..0024fd165 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -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." diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 29ae104c5..7f785b53e 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -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)))) |