summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
Diffstat (limited to 'module/system')
-rw-r--r--module/system/base/compile.scm41
-rw-r--r--module/system/base/language.scm12
-rw-r--r--module/system/repl/common.scm8
3 files changed, 20 insertions, 41 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index a90f31ef2..4d1c92fd8 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -141,9 +141,9 @@
(define* (compile-file file #:key
(output-file #f)
- (env #f)
(from (current-language))
(to 'objcode)
+ (env (default-environment from))
(opts '()))
(let* ((comp (or output-file (compiled-file-name file)))
(in (open-input-file file))
@@ -159,10 +159,11 @@
file)
comp))
-(define* (compile-and-load file #:key (from 'scheme) (to 'value) (opts '()))
+(define* (compile-and-load file #:key (from 'scheme) (to 'value)
+ (env (current-module)) (opts '()))
(read-and-compile (open-input-file file)
#:from from #:to to #:opts opts
- #:env (current-module)))
+ #:env env))
;;;
@@ -191,33 +192,10 @@
(else
(lp (cdr in) (caar in))))))
-(define (make-compilation-module)
- "Return a fresh module to be used as the compilation environment."
-
- ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
- ;; `fluid-set!', etc. don't have any effect in the current environment.
-
- (let ((m (make-module)))
- (beautify-user-module! m)
-
- ;; Provide a separate `current-reader' fluid so that the Scheme language
- ;; reader doesn't get to see the REPL's settings for `current-reader',
- ;; which would lead to an infinite loop.
- (module-define! m 'current-reader (make-fluid))
-
- m))
-
-(define (language-default-environment lang)
- "Return the default compilation environment for source language LANG."
- (if (or (eq? lang 'scheme)
- (eq? lang (lookup-language 'scheme)))
- (make-compilation-module)
- #f))
-
(define* (read-and-compile port #:key
(from (current-language))
(to 'objcode)
- (env (language-default-environment from))
+ (env (default-environment from))
(opts '()))
(let ((from (ensure-language from))
(to (ensure-language to)))
@@ -227,10 +205,11 @@
(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 (or env cenv) #:opts opts))
+ #:from joint #:to to
+ ;; env can be false if no expressions were read.
+ #:env (or env (default-environment joint))
+ #:opts opts))
(else
;; compile-fold instead of compile so we get the env too
(receive (jexp jenv jcenv)
@@ -241,7 +220,7 @@
(define* (compile x #:key
(from (current-language))
(to 'value)
- (env (language-default-environment from))
+ (env (default-environment from))
(opts '()))
(let ((warnings (memq #:warnings opts)))
diff --git a/module/system/base/language.scm b/module/system/base/language.scm
index 3670c53d9..046e11dbe 100644
--- a/module/system/base/language.scm
+++ b/module/system/base/language.scm
@@ -25,10 +25,10 @@
language-name language-title language-version language-reader
language-printer language-parser
language-compilers language-decompilers language-evaluator
- language-joiner
+ language-joiner language-make-default-environment
lookup-compilation-order lookup-decompilation-order
- invalidate-compilation-cache!))
+ invalidate-compilation-cache! default-environment))
;;;
@@ -45,7 +45,8 @@
(compilers '())
(decompilers '())
(evaluator #f)
- (joiner #f))
+ (joiner #f)
+ (make-default-environment make-fresh-user-module))
(define-macro (define-language name . spec)
`(begin
@@ -97,3 +98,8 @@
reverse!)))
(set! *decompilation-cache* (acons key order *decompilation-cache*))
order))))
+
+(define (default-environment lang)
+ "Return the default compilation environment for source language LANG."
+ ((language-make-default-environment
+ (if (language? lang) lang (lookup-language lang)))))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 8ea1c0bf6..ba18e2ea0 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -70,13 +70,7 @@
((memq #:c opts) 'glil)
(else 'objcode))))
(from (repl-language repl)))
- (compile form #:from from #:to to #:opts opts
- ;; XXX: Languages other than Scheme may not support having
- ;; a module as the environment, so work around that. See
- ;; also `language-default-environment'.
- #:env (if (eq? from (lookup-language 'scheme))
- (current-module)
- #f))))
+ (compile form #:from from #:to to #:opts opts #:env (current-module))))
(define (repl-parse repl form)
(let ((parser (language-parser (repl-language repl))))