From d62dd766856492e494ff560c05e750f006c58612 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 10 Oct 2011 17:01:11 +0200
Subject: [PATCH] add ,expand and ,optimize

* module/system/repl/command.scm (*command-table*, expand, optimize):
  New meta-commands.
* module/system/repl/common.scm (repl-expand, repl-optimize): New
  helpers.

* doc/ref/scheme-using.texi (Compile Commands): Document.
---
 doc/ref/scheme-using.texi      |  8 ++++++++
 module/system/repl/command.scm | 15 +++++++++++++++
 module/system/repl/common.scm  | 18 ++++++++++++++++++
 3 files changed, 41 insertions(+)

diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index ccf5e1e07..2713fabdd 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -271,6 +271,14 @@ Generate compiled code.
 Compile a file.
 @end deffn
 
+@deffn {REPL Command} expand exp
+Expand any macros in a form.
+@end deffn
+
+@deffn {REPL Command} optimize exp
+Run the optimizer on a piece of code and print the result.
+@end deffn
+
 @deffn {REPL Command} disassemble exp
 Disassemble a compiled procedure.
 @end deffn
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index a2f2a6f84..e27ca9a30 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -53,6 +53,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)
 	      (disassemble x) (disassemble-file xx))
     (profile  (time t) (profile pr) (trace tr))
     (debug    (backtrace bt) (up) (down) (frame fr)
@@ -459,6 +460,20 @@ Generate compiled code."
 Compile a file."
   (compile-file (->string file) #:opts opts))
 
+(define-meta-command (expand repl (form))
+  "expand EXP
+Expand any macros in a form."
+  (let ((x (repl-expand repl (repl-parse repl form))))
+    (run-hook before-print-hook x)
+    (pp x)))
+
+(define-meta-command (optimize repl (form))
+  "optimize EXP
+Run the optimizer on a piece of code and print the result."
+  (let ((x (repl-optimize repl (repl-parse repl form))))
+    (run-hook before-print-hook x)
+    (pp x)))
+
 (define (guile:disassemble x)
   ((@ (language assembly disassemble) disassemble) x))
 
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index a5267c616..718cc0b8c 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -24,12 +24,14 @@
   #:use-module (system base language)
   #:use-module (system base message)
   #:use-module (system vm program)
+  #:autoload (language tree-il optimize) (optimize!)
   #:use-module (ice-9 control)
   #:use-module (ice-9 history)
   #:export (<repl> make-repl repl-language repl-options
             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-parse repl-print repl-option-ref repl-option-set!
             repl-default-option-set! repl-default-prompt-set!
             puts ->string user-error
@@ -169,6 +171,22 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
     (compile form #:from from #:to 'objcode #:opts opts
              #:env (current-module))))
 
+(define (repl-expand repl form)
+  (let ((from (repl-language repl))
+        (opts (repl-compile-options repl)))
+    (decompile (compile form #:from from #:to 'tree-il #:opts opts
+                        #:env (current-module))
+               #:from 'tree-il #:to from)))
+
+(define (repl-optimize repl form)
+  (let ((from (repl-language repl))
+        (opts (repl-compile-options repl)))
+    (decompile (optimize! (compile form #:from from #:to 'tree-il #:opts opts
+                                   #:env (current-module))
+                          (current-module)
+                          opts)
+               #:from 'tree-il #:to from)))
+
 (define (repl-parse repl form)
   (let ((parser (language-parser (repl-language repl))))
     (if parser (parser form) form)))
-- 
2.20.1