mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

no more *compilation-environment* fluid

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-10-16 14:04:42 +02:00
parent 4b2afc6258
commit 40867c9776
2 changed files with 10 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/language/tree-il/analyze.scm
View file

@ -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.

29
module/system/base/compile.scm
View file

@ -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))