summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-05-08 17:28:55 +0200
committerAndy Wingo <wingo@pobox.com>2020-05-08 17:28:55 +0200
commitded883b6f0af5320eb2ebaaee881acf08dcc4a37 (patch)
tree59d9550ed4024a459fcbcfe691d92ca944533a8c /module/system
parent4311dc9858ba7c6db50a851e95fc7c387b9381b2 (diff)
downloadguile-ded883b6f0af5320eb2ebaaee881acf08dcc4a37.tar.gz
Sketch of how to choose different compiler based on -O0
* module/system/base/compile.scm (next-pass, compute-compiler): Allow optimization level to determine pass order.
Diffstat (limited to 'module/system')
-rw-r--r--module/system/base/compile.scm22
1 files changed, 16 insertions, 6 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 3ea1e7aca..b7d6da446 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -230,18 +230,28 @@
(#f (lambda (exp env) exp))
(proc (proc optimization-level opts))))
+(define (next-pass from lang to optimization-level opts)
+ (if (eq? lang to)
+ #f ;; Done.
+ (match (language-compilers lang)
+ (((name . pass))
+ (cons (lookup-language name) pass))
+ ((_ _)
+ (error "multiple compilers; language should supply chooser"))
+ (_
+ (error "no way to compile" from "to" to)))))
+
(define (compute-compiler from to optimization-level warning-level opts)
- (let lp ((order (or (lookup-compilation-order from to)
- (error "no way to compile" from "to" to))))
- (match order
- (() (lambda (exp env) (values exp env env)))
- (((lang . pass) . order)
+ (let lp ((lang from))
+ (match (next-pass from lang to optimization-level opts)
+ (#f (lambda (exp env) (values exp env env)))
+ ((next . pass)
(let* ((analyze (compute-analyzer lang warning-level opts))
(lower (compute-lowerer lang optimization-level opts))
(compile (lambda (exp env)
(analyze exp env)
(pass (lower exp env) env opts)))
- (tail (lp order)))
+ (tail (lp next)))
(lambda (exp env)
(let*-values (((exp env cenv) (compile exp env))
((exp env cenv*) (tail exp env)))