summaryrefslogtreecommitdiff
path: root/module/scripts
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-05-08 16:47:07 +0200
committerAndy Wingo <wingo@pobox.com>2020-05-08 17:07:56 +0200
commit4311dc9858ba7c6db50a851e95fc7c387b9381b2 (patch)
tree6ad4eaa887b09aadea70c0664eb5ddf66becb136 /module/scripts
parente9c0f3071dedb0f6b39757e920cdc182435c8725 (diff)
downloadguile-4311dc9858ba7c6db50a851e95fc7c387b9381b2.tar.gz
Define new "lowering" phase in compiler
* module/language/cps/compile-bytecode.scm (compile-bytecode): * module/language/tree-il/compile-bytecode.scm (compile-bytecode): * module/language/tree-il/compile-cps.scm (compile-cps): Rely on compiler to lower incoming term already. * module/language/tree-il/optimize.scm (make-lowerer): New procedure. * module/system/base/compile.scm (compute-lowerer): New procedure, replaceing add-default-optimizations. (compute-compiler): Lower before running compiler. * module/system/base/language.scm (<language>): Change optimizations-for-level field to "lowerer". * module/scripts/compile.scm (%options, compile): Parse -O0, -O1 and so on to #:optimization-level instead of expanding to all the optimization flags. * module/language/cps/optimize.scm (lower-cps): Move here from compile-bytecode.scm. (make-cps-lowerer): New function. * module/language/cps/spec.scm (cps): Declare lowerer.
Diffstat (limited to 'module/scripts')
-rw-r--r--module/scripts/compile.scm26
1 files changed, 16 insertions, 10 deletions
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index 7b6daea85..5d91538c3 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -113,10 +113,12 @@
((string=? arg "help")
(show-optimization-help)
(exit 0))
- ((equal? arg "0") (return (optimizations-for-level 0)))
- ((equal? arg "1") (return (optimizations-for-level 1)))
- ((equal? arg "2") (return (optimizations-for-level 2)))
- ((equal? arg "3") (return (optimizations-for-level 3)))
+ ((string->number arg)
+ => (lambda (level)
+ (unless (and (exact-integer? level) (<= 0 level 9))
+ (fail "Bad optimization level `~a'" level))
+ (alist-cons 'optimization-level level
+ (alist-delete 'optimization-level result))))
((string-prefix? "no-" arg)
(return-option (substring arg 3) #f))
(else
@@ -153,6 +155,7 @@ options."
`((input-files)
(load-path)
(warning-level . ,(default-warning-level))
+ (optimization-level . ,(default-optimization-level))
(warnings unsupported-warning))))
(define (show-version)
@@ -197,6 +200,7 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
(let* ((options (parse-args args))
(help? (assoc-ref options 'help?))
(warning-level (assoc-ref options 'warning-level))
+ (optimization-level (assoc-ref options 'optimization-level))
(compile-opts `(#:warnings
,(assoc-ref options 'warnings)
,@(append-map
@@ -275,12 +279,14 @@ Report bugs to <~A>.~%"
(with-fluids ((*current-warning-prefix* ""))
(with-target target
(lambda ()
- (compile-file file
- #:output-file output-file
- #:from from
- #:to to
- #:warning-level warning-level
- #:opts compile-opts))))))
+ (compile-file
+ file
+ #:output-file output-file
+ #:from from
+ #:to to
+ #:warning-level warning-level
+ #:optimization-level optimization-level
+ #:opts compile-opts))))))
input-files)))
(define main compile)