diff options
author | Andy Wingo <wingo@pobox.com> | 2020-05-08 17:28:55 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2020-05-08 17:28:55 +0200 |
commit | ded883b6f0af5320eb2ebaaee881acf08dcc4a37 (patch) | |
tree | 59d9550ed4024a459fcbcfe691d92ca944533a8c /module/system | |
parent | 4311dc9858ba7c6db50a851e95fc7c387b9381b2 (diff) | |
download | guile-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.scm | 22 |
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))) |