[Guile-commits] branch master updated: Sketch of how to choose different compiler based on -O0

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new ded883b  Sketch of how to choose different compiler based on -O0
ded883b is described below

commit ded883b6f0af5320eb2ebaaee881acf08dcc4a37
Author: Andy Wingo <address@hidden>
AuthorDate: Fri May 8 17:28:55 2020 +0200

    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.
---
 module/system/base/compile.scm | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 3ea1e7a..b7d6da4 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)))