mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
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.
This commit is contained in:
parent
4311dc9858
commit
ded883b6f0
1 changed files with 16 additions and 6 deletions
|
@ -230,18 +230,28 @@
|
||||||
(#f (lambda (exp env) exp))
|
(#f (lambda (exp env) exp))
|
||||||
(proc (proc optimization-level opts))))
|
(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)
|
(define (compute-compiler from to optimization-level warning-level opts)
|
||||||
(let lp ((order (or (lookup-compilation-order from to)
|
(let lp ((lang from))
|
||||||
(error "no way to compile" from "to" to))))
|
(match (next-pass from lang to optimization-level opts)
|
||||||
(match order
|
(#f (lambda (exp env) (values exp env env)))
|
||||||
(() (lambda (exp env) (values exp env env)))
|
((next . pass)
|
||||||
(((lang . pass) . order)
|
|
||||||
(let* ((analyze (compute-analyzer lang warning-level opts))
|
(let* ((analyze (compute-analyzer lang warning-level opts))
|
||||||
(lower (compute-lowerer lang optimization-level opts))
|
(lower (compute-lowerer lang optimization-level opts))
|
||||||
(compile (lambda (exp env)
|
(compile (lambda (exp env)
|
||||||
(analyze exp env)
|
(analyze exp env)
|
||||||
(pass (lower exp env) env opts)))
|
(pass (lower exp env) env opts)))
|
||||||
(tail (lp order)))
|
(tail (lp next)))
|
||||||
(lambda (exp env)
|
(lambda (exp env)
|
||||||
(let*-values (((exp env cenv) (compile exp env))
|
(let*-values (((exp env cenv) (compile exp env))
|
||||||
((exp env cenv*) (tail exp env)))
|
((exp env cenv*) (tail exp env)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue