Delay loading CPS unless CPS compiler used

* module/language/tree-il/spec.scm: Remove #:compilers declaration;
  instead rely on choose-compiler.
  (choose-compiler): Load compilers on demand.
* module/system/base/compile.scm (find-language-joint): Use next-pass
  instead of lookup-compilation-order, to avoid loading unused
  compilers.
  (read-and-compile): Adapt to find-language-joint change.
  (compute-compiler): Export.
* module/scripts/compile.scm (compile): Use compute-compiler to load
  compiler modules.

module/language/tree-il/spec.scm

@@ -1,6 +1,6 @@
 ;;; Tree Intermediate Language
 
-;; Copyright (C) 2009, 2010, 2011, 2013, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011,2013,2015,2020 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -22,8 +22,6 @@
   #:use-module (system base language)
   #:use-module (ice-9 match)
   #:use-module (language tree-il)
-  #:use-module (language tree-il compile-cps)
-  #:use-module (language tree-il compile-bytecode)
   #:use-module ((language tree-il analyze) #:select (make-analyzer))
   #:use-module ((language tree-il optimize) #:select (make-lowerer))
   #:export (tree-il))
@@ -40,11 +38,13 @@
     (_ (error "what!" exps env))))
 
 (define (choose-compiler target optimization-level opts)
+  (define (load-compiler compiler)
+    (module-ref (resolve-interface `(language tree-il ,compiler)) compiler))
   (if (match (memq #:cps? opts)
         ((_ cps? . _) cps?)
         (#f (<= 1 optimization-level)))
-      (cons 'cps compile-cps)
-      (cons 'bytecode compile-bytecode)))
+      (cons 'cps (load-compiler 'compile-bytecode))
+      (cons 'bytecode (load-compiler 'compile-bytecode))))
 
 (define-language tree-il
   #:title	"Tree Intermediate Language"
@@ -52,8 +52,6 @@
   #:printer	write-tree-il
   #:parser      parse-tree-il
   #:joiner      join
-  #:compilers   `((cps . ,compile-cps)
-                  (bytecode . ,compile-bytecode))
   #:compiler-chooser choose-compiler
   #:analyzer    make-analyzer
   #:lowerer     make-lowerer

module/scripts/compile.scm

@@ -29,8 +29,8 @@
 ;;; Code:
 
 (define-module (scripts compile)
-  #:use-module ((system base language) #:select (lookup-language))
-  #:use-module ((system base compile) #:select (compile-file
+  #:use-module ((system base compile) #:select (compute-compiler
+                                                compile-file
                                                 default-warning-level
                                                 default-optimization-level))
   #:use-module (system base target)
@@ -250,12 +250,12 @@ Report bugs to <~A>.~%"
     (when (assoc-ref options 'install-r7rs?)
       (install-r7rs!))
 
-    ;; Load FROM and TO before we have changed the load path.  That way, when
-    ;; cross-compiling Guile itself, we can be sure we're loading our own
-    ;; language modules and not those of the Guile being compiled, which may
-    ;; have incompatible .go files.
-    (lookup-language from)
-    (lookup-language to)
+    ;; Compute a compiler before changing the load path, for its side
+    ;; effects of loading compiler modules.  That way, when
+    ;; cross-compiling Guile itself, we can be sure we're loading our
+    ;; own language modules and not those of the Guile being compiled,
+    ;; which may have incompatible .go files.
+    (compute-compiler from to optimization-level warning-level compile-opts)
 
     (set! %load-path (append load-path %load-path))
     (set! %load-should-auto-compile #f)

module/system/base/compile.scm

@@ -26,6 +26,7 @@
   #:export (compiled-file-name
             compile-file
             compile-and-load
+            compute-compiler
             read-and-compile
             compile
             decompile
@@ -267,18 +268,16 @@
                ;; unit.
                (values exp env cenv)))))))))
 
-(define (find-language-joint from to)
-  (match (lookup-compilation-order from to)
-    (((langs . passes) ...)
-     (or (let lp ((langs langs))
-           (match langs
-             (() #f)
-             ((lang . langs)
-              (or (lp langs)
-                  (and (language-joiner lang)
-                       lang)))))
-         to))
-    (_ (error "no way to compile" from "to" to))))
+(define (find-language-joint from to optimization-level opts)
+  (let ((from (ensure-language from))
+        (to (ensure-language to)))
+    (let lp ((lang from))
+      (match (next-pass from lang to optimization-level opts)
+        (#f #f)
+        ((next . pass)
+         (or (lp next)
+             (and (language-joiner next)
+                  next)))))))
 
 (define (default-language-joiner lang)
   (lambda (exps env)
@@ -305,7 +304,7 @@
                            (opts '()))
   (let* ((from (ensure-language from))
          (to (ensure-language to))
-         (joint (find-language-joint from to)))
+         (joint (find-language-joint from to optimization-level opts)))
     (parameterize ((current-language from))
       (let lp ((exps '()) (env #f) (cenv env) (from #f) (compile1 #f))
         (match (read-and-parse (current-language) port cenv)