current-language is a parameter in boot-9

* module/ice-9/boot-9.scm (current-language): New parameter.

* module/system/base/language.scm (*current-language*): Pull fluid from
  parameter.
  (current-language): Now a re-exported parameter.

* doc/ref/compiler.texi: Update reference from *current-language* fluid
  to current-language parameter.

* module/system/base/compile.scm (compile-and-load):
* module/ice-9/top-repl.scm (top-repl): Default to the current language,
  not to Scheme.

* module/ice-9/eval-string.scm:
* module/system/base/language.scm:
* module/system/repl/command.scm:
* module/system/repl/repl.scm: Update to use current-language parameter
  and parameterize.

8 files changed, 33 insertions, 21 deletions

diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index 25cf524e9..a88942d02 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -1,6 +1,6 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  2008, 2009, 2010
+@c Copyright (C)  2008, 2009, 2010, 2013
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
@@ -112,9 +112,10 @@ subsequent calls to @code{define-language}, so it should be quite
 fast.
 @end deffn
 
-There is a notion of a ``current language'', which is maintained in
-the @code{*current-language*} fluid. This language is normally Scheme,
-and may be rebound by the user. The run-time compilation interfaces
+There is a notion of a ``current language'', which is maintained in the
+@code{current-language} parameter, defined in the core @code{(guile)}
+module. This language is normally Scheme, and may be rebound by the
+user. The run-time compilation interfaces
 (@pxref{Read/Load/Eval/Compile}) also allow you to choose other source
 and target languages.
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a22ac8bb5..4efd7535d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3047,6 +3047,17 @@ CONV is not applied to the initial value."
 
 
 
+;;;
+;;; Languages.
+;;;
+
+;; The language can be a symbolic name or a <language> object from
+;; (system base language).
+;;
+(define current-language (make-parameter 'scheme))
+
+
+
 
 ;;; {Running Repls}
 ;;;
diff --git a/module/ice-9/eval-string.scm b/module/ice-9/eval-string.scm
index 27448d73f..649551d9f 100644
--- a/module/ice-9/eval-string.scm
+++ b/module/ice-9/eval-string.scm
@@ -1,6 +1,6 @@
 ;;; Evaluating code from users
 
-;;; Copyright (C) 2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2011, 2013 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
@@ -30,7 +30,7 @@
       (lookup-language x)))
 
 (define* (read-and-eval port #:key (lang (current-language)))
-  (with-fluids ((*current-language* (ensure-language lang)))
+  (parameterize ((current-language (ensure-language lang)))
     (define (read)
       ((language-reader (current-language)) port (current-module)))
     (define (eval exp)
diff --git a/module/ice-9/top-repl.scm b/module/ice-9/top-repl.scm
index d43436c4a..302729792 100644
--- a/module/ice-9/top-repl.scm
+++ b/module/ice-9/top-repl.scm
@@ -1,7 +1,7 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 
 ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;;   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2013 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
@@ -73,6 +73,6 @@
                         "warning: failed to install locale: ~a~%"
                         (strerror (car errno))))))
 
-       (let ((status (start-repl 'scheme)))
+       (let ((status (start-repl (current-language))))
          (run-hook exit-hook)
          status)))))
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0e44f362c..f92ca7dd1 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -152,7 +152,7 @@
         file)
       comp)))
 
-(define* (compile-and-load file #:key (from 'scheme) (to 'value)
+(define* (compile-and-load file #:key (from (current-language)) (to 'value)
                            (env (current-module)) (opts '())
                            (canonicalization 'relative))
   (with-fluids ((%file-port-name-canonicalization canonicalization))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
index 5b27bc98d..81b43b70d 100644
--- a/module/system/base/language.scm
+++ b/module/system/base/language.scm
@@ -1,6 +1,6 @@
 ;;; Multi-language support
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2013 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
@@ -30,7 +30,9 @@
             lookup-compilation-order lookup-decompilation-order
             invalidate-compilation-cache! default-environment
 
-            *current-language* current-language))
+            *current-language*)
+
+  #:re-export (current-language))
 
 
 ;;;
@@ -111,7 +113,5 @@
 ;;; Current language
 ;;;
 
-(define *current-language* (make-fluid 'scheme))
-
-(define (current-language)
-  (fluid-ref *current-language*))
+;; Deprecated; use current-language instead.
+(define *current-language* (parameter-fluid current-language))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index ae8bdea7f..c4e9e2ce5 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -1,6 +1,6 @@
 ;;; Repl commands
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2013 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
@@ -446,7 +446,7 @@ Change languages."
         (cur (repl-language repl)))
     (format #t "Happy hacking with ~a!  To switch back, type `,L ~a'.\n"
             (language-title lang) (language-name cur))
-    (fluid-set! *current-language* lang)
+    (current-language lang)
     (set! (repl-language repl) lang)))
 
 
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index f7b022999..7d2b7c836 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -1,6 +1,6 @@
 ;;; Read-Eval-Print Loop
 
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2013 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
@@ -132,9 +132,9 @@
 ;;;
 
 (define* (start-repl #:optional (lang (current-language)) #:key debug)
-  ;; ,language at the REPL will fluid-set! the *current-language*.  Make
-  ;; sure that it does so in a new scope.
-  (with-fluids ((*current-language* lang))
+  ;; ,language at the REPL will update the current-language.  Make
+  ;; sure that it does so in a new dynamic scope.
+  (parameterize ((current-language lang))
     (run-repl (make-repl lang debug))))
 
 ;; (put 'abort-on-error 'scheme-indent-function 1)