diff options
Diffstat (limited to 'scheme/plt')
| -rw-r--r-- | scheme/plt/geiser.ss | 3 | ||||
| -rw-r--r-- | scheme/plt/geiser/eval.ss | 23 | ||||
| -rw-r--r-- | scheme/plt/geiser/modules.ss | 34 |
3 files changed, 33 insertions, 27 deletions
diff --git a/scheme/plt/geiser.ss b/scheme/plt/geiser.ss index c46f06c..a86b6a9 100644 --- a/scheme/plt/geiser.ss +++ b/scheme/plt/geiser.ss @@ -38,7 +38,8 @@ geiser/locations geiser/autodoc) - (define geiser:eval eval-in) + (define (geiser:eval lang) + (lambda (form spec) (eval-in form spec lang))) (define geiser:compile compile-in) (define geiser:load-file load-file) (define geiser:compile-file compile-file) diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss index 86b10cd..d432daa 100644 --- a/scheme/plt/geiser/eval.ss +++ b/scheme/plt/geiser/eval.ss @@ -41,27 +41,28 @@ (define (set-last-result . vs) (set! last-result `((result ,@(map write-value vs))))) -(define (eval-in form spec) +(define (call-with-result thunk) (set-last-result (void)) (let ((output (with-output-to-string (lambda () (with-handlers ((exn? set-last-error)) - (update-module-cache spec form) - (call-with-values - (lambda () (eval form (module-spec->namespace spec))) - set-last-result)))))) + (call-with-values thunk set-last-result)))))) (append last-result `((output . ,output))))) +(define (eval-in form spec lang) + (call-with-result + (lambda () + (update-module-cache spec form) + (eval form (module-spec->namespace spec lang))))) + (define compile-in eval-in) (define (load-file file) - (let ((current-path (namespace->module-path-name (last-namespace))) - (result (eval-in `(load-module ,file (current-output-port)) - 'geiser/eval))) - (update-module-cache file) - (load-module (and (path? current-path) (path->string current-path))) - result)) + (call-with-result + (lambda () + (load-module file (current-output-port) (last-namespace)) + (update-module-cache file)))) (define compile-file load-file) diff --git a/scheme/plt/geiser/modules.ss b/scheme/plt/geiser/modules.ss index 3dea0c3..3d6314d 100644 --- a/scheme/plt/geiser/modules.ss +++ b/scheme/plt/geiser/modules.ss @@ -24,30 +24,32 @@ (define (ensure-module-spec spec) (cond ((symbol? spec) spec) ((not (string? spec)) #f) - ((not (file-exists? spec)) #f) - ((absolute-path? spec) `(file ,spec)) - (else spec))) + (else `(file ,spec)))) -(define (module-spec->namespace spec) +(define (module-spec->namespace spec lang) (let* ((spec (ensure-module-spec spec)) - (contract-handler (lambda (e) - (load-module spec) - (enter! #f) - (module->namespace spec))) + (try-lang (lambda (e) + (if (symbol? lang) + (begin + (load-module lang #f (current-namespace)) + (module->namespace lang)) + (current-namespace)))) (filesystem-handler (lambda (e) - (when (symbol? spec) + (with-handlers ((exn? try-lang)) (module->namespace `',spec))))) (if spec - (with-handlers ((exn:fail:contract? contract-handler) - (exn:fail:filesystem? filesystem-handler)) + (with-handlers ((exn:fail:filesystem? filesystem-handler) + (exn? try-lang)) (module->namespace spec)) (current-namespace)))) (define nowhere (open-output-nowhere)) -(define (load-module spec . port) - (parameterize ((current-error-port (if (null? port) nowhere (car port)))) - (eval #`(enter! #,(ensure-module-spec spec))))) +(define (load-module spec (port #f) (ns #f)) + (parameterize ((current-error-port (or port nowhere))) + (eval #`(enter! #,(ensure-module-spec spec))) + (when (namespace? ns) + (current-namespace ns)))) (define (namespace->module-path-name ns) (let ((rmp (variable-reference->resolved-module-path @@ -67,7 +69,9 @@ (current-library-collection-paths))) (prefix-len (lambda (p) (let ((pl (string-length p))) - (if (= pl (string-prefix-length p path)) pl 0)))) + (if (= pl (string-prefix-length p path)) + pl + 0)))) (lens (map prefix-len cpaths)) (real-path (substring path (apply max lens)))) (if (absolute-path? real-path) |