no more *compilation-environment* fluid

* module/system/base/compile.scm (current-compilation-environment):
  Remove, as the only thing that needed it (language readers) now get
  the environment as an argument.
  (read-and-compile, compile): Rework for no *compilation-environment*,
  and default the environment using the define* mechanism.

* module/language/tree-il/analyze.scm (env-module): Hack around the lack
  of a current compilation module. Will fix this in the next commit so
  that the environment is always valid.

diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 74d41f2..46e4677 100644 (file)
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -24,8 +24,6 @@
   #:use-module (system base syntax)
   #:use-module (system base message)
   #:use-module (language tree-il)
-  #:use-module ((system base compile)
-                #:select (current-compilation-environment))
   #:export (analyze-lexicals
             report-unused-variables
             report-possibly-unbound-variables))
@@ -641,7 +639,7 @@
   ;; environments is hidden in `(language scheme compile-tree-il)'.
   (cond ((pair? e)   (car e))
         ((module? e) e)
-        (else        (current-compilation-environment))))
+        (else        (current-module))))
 
 ;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
 ;; once for each warning type.

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 11c23af..a90f31e 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -28,7 +28,6 @@
   #:use-module (ice-9 receive)
   #:export (syntax-error 
             *current-language*
-            current-compilation-environment
             compiled-file-name compile-file compile-and-load
             compile
             decompile)
@@ -64,12 +63,6 @@
 (define (current-language)
   (fluid-ref *current-language*))
 
-(define *compilation-environment* (make-fluid))
-(define (current-compilation-environment)
-  "Return the current compilation environment (a module) or #f.  This
-function should only be called from stages in the compiler tower."
-  (fluid-ref *compilation-environment*))
-
 (define (call-once thunk)
   (let ((entered #f))
     (dynamic-wind
@@ -222,24 +215,22 @@ function should only be called from stages in the compiler tower."
       #f))
 
 (define* (read-and-compile port #:key
-                           (env #f)
                            (from (current-language))
                            (to 'objcode)
+                           (env (language-default-environment from))
                            (opts '()))
   (let ((from (ensure-language from))
         (to (ensure-language to)))
     (let ((joint (find-language-joint from to)))
-      (with-fluids ((*current-language* from)
-                    (*compilation-environment*
-                     (or env
-                         (language-default-environment from))))
-        (let lp ((exps '()) (env #f)
-                 (cenv (fluid-ref *compilation-environment*)))
-          (let ((x ((language-reader (current-language)) port env)))
+      (with-fluids ((*current-language* from))
+        (let lp ((exps '()) (env #f) (cenv env))
+          (let ((x ((language-reader (current-language)) port cenv)))
             (cond
              ((eof-object? x)
+              ;; FIXME: what if there are no expressions to be read?
+              ;; then env is #f. Here default to cenv in that case.
               (compile ((language-joiner joint) (reverse exps) env)
-                       #:from joint #:to to #:env env #:opts opts))
+                       #:from joint #:to to #:env (or env cenv) #:opts opts))
              (else
               ;; compile-fold instead of compile so we get the env too
               (receive (jexp jenv jcenv)
@@ -248,9 +239,9 @@ function should only be called from stages in the compiler tower."
                 (lp (cons jexp exps) jenv jcenv))))))))))
 
 (define* (compile x #:key
-                  (env #f)
                   (from (current-language))
                   (to 'value)
+                  (env (language-default-environment from))
                   (opts '()))
 
   (let ((warnings (memq #:warnings opts)))
@@ -263,9 +254,7 @@ function should only be called from stages in the compiler tower."
                     warnings))))
 
   (receive (exp env cenv)
-      (let ((env (or env (language-default-environment from))))
-        (with-fluids ((*compilation-environment* env))
-          (compile-fold (compile-passes from to opts) x env opts)))
+      (compile-fold (compile-passes from to opts) x env opts)
     exp))
 
 \f