bug#45131: [PATCH] Compile directly to target language if no joint is found.

This enables the compilation from "manually" written Tree-IL to
bytecode.  See also <https://bugs.gnu.org/45131>.

* system/base/compile.scm (read-and-compile)[(joint #f)]<? eof-object?>:
Join exps using the default joiner for to.
<exp>: Compute compiler for to.
* test-suite/test/compiler.test ("read-and-compile tree-il"): New test.

module/system/base/compile.scm

@@ -310,6 +310,7 @@
         (match (read-and-parse (current-language) port cenv)
           ((? eof-object?)
            (close-port port)
+           (if joint
                (compile ((or (language-joiner joint)
                              (default-language-joiner joint))
                          (reverse exps)
@@ -319,7 +320,10 @@
                         #:env (or env (default-environment joint))
                         #:optimization-level optimization-level
                         #:warning-level warning-level
-                    #:opts opts))
+                        #:opts opts)
+               ((default-language-joiner to)
+                (reverse exps)
+                env)))
           (exp
            (let with-compiler ((from from) (compile1 compile1))
              (cond
@@ -332,7 +336,7 @@
                (let ((from (current-language)))
                  (with-compiler
                   from
-                  (compute-compiler from joint optimization-level
+                  (compute-compiler from (or joint to) optimization-level
                                     warning-level opts))))))))))))
 
 (define* (compile x #:key

test-suite/tests/compiler.test

@@ -368,3 +368,26 @@
 
   (pass-if-equal "test terminates without error" '(#t #t)
     (test-proc '((V X) (Y Z)))))
+
+(with-test-prefix "read-and-compile tree-il"
+  (let ((code
+         "\
+(seq
+  (define forty-two
+    (lambda ((name . forty-two))
+            (lambda-case ((() #f #f #f () ()) (const 42)))))
+  (toplevel forty-two))")
+        (bytecode #f)
+        (proc #f))
+    (pass-if "compiling tree-il works"
+      (begin
+        (set! bytecode
+          (call-with-input-string code
+            (lambda (port)
+              (read-and-compile port #:from 'tree-il))))
+        #t))
+    (pass-if "bytecode can be read"
+      (begin
+        (set! proc ((load-thunk-from-memory bytecode)))
+        (procedure? proc)))
+    (pass-if-equal "proc executes" 42 (proc))))