diff options
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/base/compile.scm | 41 | ||||
-rw-r--r-- | module/system/base/language.scm | 12 | ||||
-rw-r--r-- | module/system/repl/common.scm | 8 |
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)))) |