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

Fix ,optimize to be independent of tree-il

Browse source 
* module/system/repl/common.scm (repl-default-options): Add
  optimization-level and warning-level REPL options.
  (repl-optimization-level, repl-warning-level): New accessors,
  defaulting to the default level parameters.
  (repl-expand): Take target language as keyword argument rather than
  hard-coding tree-il.
  (repl-optimize): Take target language as keyword argument.  Use REPL
  optimization and warning levels.  Use generic lowering interface.
This commit is contained in:
Andy Wingo 2020-05-14 09:13:51 +02:00
parent 7df3f3414b
commit 033a67d575
1 changed files with 34 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

44
module/system/repl/common.scm
View file

@ -25,7 +25,6 @@
#:use-module (system base message) #:use-module (system base message)
#:use-module (system vm program) #:use-module (system vm program)
#:use-module (system vm loader) #:use-module (system vm loader)
#: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
@ -111,6 +110,14 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(define repl-default-options (define repl-default-options
(copy-tree (copy-tree
`((compile-options ,%auto-compilation-options #f) `((compile-options ,%auto-compilation-options #f)
(optimization-level #f (lambda (x)
(unless (and (exact-integer? x) (<= 0 x 9))
(error "Invalid optimization level" x))
x))
(warning-level #f (lambda (x)
(unless (and (exact-integer? x) (<= 0 x 9))
(error "Invalid warning level" x))
x))
(trace #f #f) (trace #f #f)
(interp #f #f) (interp #f #f)
(prompt #f ,(lambda (prompt) (prompt #f ,(lambda (prompt)
@ -173,27 +180,44 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(define (repl-compile-options repl) (define (repl-compile-options repl)
(repl-option-ref repl 'compile-options)) (repl-option-ref repl 'compile-options))
(define (repl-optimization-level repl)
(or (repl-option-ref repl 'optimization-level)
(default-optimization-level)))
(define (repl-warning-level repl)
(or (repl-option-ref repl 'warning-level)
(default-warning-level)))
(define (repl-compile repl form) (define (repl-compile repl form)
(let ((from (repl-language repl)) (let ((from (repl-language repl))
(opts (repl-compile-options repl))) (opts (repl-compile-options repl)))
(compile form #:from from #:to 'bytecode #:opts opts (compile form #:from from #:to 'bytecode #:opts opts
#:optimization-level (repl-optimization-level repl)
#:warning-level (repl-warning-level repl)
#:env (current-module)))) #:env (current-module))))
(define (repl-expand repl form) (define* (repl-expand repl form #:key (lang 'tree-il))
(let ((from (repl-language repl)) (let ((from (repl-language repl))
(opts (repl-compile-options repl))) (opts (repl-compile-options repl)))
(decompile (compile form #:from from #:to 'tree-il #:opts opts (decompile (compile form #:from from #:to lang #:opts opts
#:env (current-module)) #:env (current-module))
#:from 'tree-il #:to from))) #:from lang #:to from)))
(define (repl-optimize repl form) (define* (repl-optimize repl form #:key (lang 'tree-il))
(let ((from (repl-language repl)) (let ((from (repl-language repl))
(make-lower (language-lowerer (lookup-language lang)))
(optimization-level (repl-optimization-level repl))
(warning-level (repl-warning-level repl))
(opts (repl-compile-options repl))) (opts (repl-compile-options repl)))
(decompile (optimize (compile form #:from from #:to 'tree-il #:opts opts (unless make-lower
#:env (current-module)) (error "language has no optimizer" lang))
(current-module) (decompile ((make-lower optimization-level opts)
opts) (compile form #:from from #:to lang #:opts opts
#:from 'tree-il #:to from))) #:optimization-level optimization-level
#:warning-level warning-level
#:env (current-module))
(current-module))
#:from lang #: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))))