1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00

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.
This commit is contained in:
Andy Wingo 2011-10-10 17:01:11 +02:00
parent 34c5fe83c0
commit d62dd76685
3 changed files with 41 additions and 0 deletions

View file

@ -271,6 +271,14 @@ Generate compiled code.
Compile a file. Compile a file.
@end deffn @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 @deffn {REPL Command} disassemble exp
Disassemble a compiled procedure. Disassemble a compiled procedure.
@end deffn @end deffn

View file

@ -53,6 +53,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)
(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)
@ -459,6 +460,20 @@ Generate compiled code."
Compile a file." Compile a file."
(compile-file (->string file) #:opts opts)) (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) (define (guile:disassemble x)
((@ (language assembly disassemble) disassemble) x)) ((@ (language assembly disassemble) disassemble) x))

View file

@ -24,12 +24,14 @@
#:use-module (system base language) #:use-module (system base language)
#:use-module (system base message) #:use-module (system base message)
#:use-module (system vm program) #:use-module (system vm program)
#:autoload (language tree-il optimize) (optimize!)
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:use-module (ice-9 history) #:use-module (ice-9 history)
#:export (<repl> make-repl repl-language repl-options #:export (<repl> make-repl repl-language repl-options
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-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
@ -169,6 +171,22 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(compile form #:from from #:to 'objcode #:opts opts (compile form #:from from #:to 'objcode #:opts opts
#:env (current-module)))) #: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) (define (repl-parse repl form)
(let ((parser (language-parser (repl-language repl)))) (let ((parser (language-parser (repl-language repl))))
(if parser (parser form) form))) (if parser (parser form) form)))