*current-language*

[BT Templeton]

What is `*current-language*' supposed to be used for? I see that it's
set by `(@ (ice-9 eval-string) read-and-eval)' and by `(@ (system base
compile) read-and-compile)', but not by the REPL. So calling
`primitive-load-path' on a Scheme file from a REPL for another language
works as expected, but it fails if called from a context in which
`*current-language*' is bound to a value other than the default. For
example:

    scheme@(guile-user)> ,use (ice-9 eval-string)
    scheme@(guile-user)> (eval-string
    ... "(eval-when-compile
    ...    (funcall (guile-ref (guile) primitive-load-path)
    ...             \"texinfo.scm\"))"
    ... #:lang 'elisp)
    ;;; note: source file /home/bpt/src/guile/module/texinfo.scm
    ;;;       newer than compiled /home/bpt/[...]/texinfo.scm.go
    ;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
    ;;;       or pass the --no-auto-compile argument to disable.
    ;;; compiling /home/bpt/src/guile/module/texinfo.scm
    ;;; WARNING: compilation of /home/bpt/src/guile/module/texinfo.scm failed:
    ;;; key wrong-type-arg, throw args [...]
    $1 = nil

(This example currently only works in my copy of Guile, since it
requires an `eval-when-compile' special operator for Elisp.)

I think it might be preferable to require explicit language arguments to
all compilation functions, or to default to Scheme explicitly.

But another solution for this particular bug would be to have
`compile-file' guess the language based on the file extension, and then
`primitive-load-path' and similar functions would work with other
languages too. A simple patch implementing this follows. A complete
solution would be more general than this, of course, and might involve
making load.c aware of the existence of other languages or rewriting
some loading functions in Scheme.

index 1b6e73f..3bc8c23 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -120,9 +120,18 @@
          (and (false-if-exception (ensure-writable-dir (dirname f)))
               f))))
 
+(define (guess-file-language file)
+  (cond
+   ((string-suffix? ".scm" file)
+    (lookup-language 'scheme))
+   ((string-suffix? ".el" file)
+    (lookup-language 'elisp))
+   (else
+    (current-language))))
+
 (define* (compile-file file #:key
                        (output-file #f)
-                       (from (current-language))
+                       (from (guess-file-language file))
                        (to 'objcode)
                        (env (default-environment from))
                        (opts '())