summaryrefslogtreecommitdiff
path: root/module/system/repl
diff options
context:
space:
mode:
Diffstat (limited to 'module/system/repl')
-rw-r--r--module/system/repl/command.scm17
-rw-r--r--module/system/repl/common.scm26
2 files changed, 29 insertions, 14 deletions
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index ac1fa0933..0024fd165 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -1,6 +1,6 @@
;;; Repl commands
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2020, 2021 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -22,10 +22,12 @@
(define-module (system repl command)
#:use-module (system base syntax)
#:use-module (system base pmatch)
- #:use-module (system base compile)
+ #:autoload (system base compile) (compile-file)
#:use-module (system repl common)
#:use-module (system repl debug)
- #:use-module (system vm disassembler)
+ #:autoload (system vm disassembler) (disassemble-image
+ disassemble-program
+ disassemble-file)
#:use-module (system vm loader)
#:use-module (system vm program)
#:use-module (system vm trap-state)
@@ -42,7 +44,7 @@
#:use-module ((ice-9 pretty-print) #:select ((pretty-print . pp)))
#:use-module ((system vm inspect) #:select ((inspect . %inspect)))
#:use-module (rnrs bytevectors)
- #:use-module (statprof)
+ #:autoload (statprof) (statprof)
#:export (meta-command define-meta-command))
@@ -55,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)
@@ -488,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))))