summaryrefslogtreecommitdiff
path: root/scheme/plt/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-10-15 02:34:21 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-10-15 02:34:21 +0200
commitb007b8801197325f3bd157c383bdfcace0ff57fc (patch)
tree11f183ece13c67111cac6b8716ed905e4569c193 /scheme/plt/geiser
parentd56dfe6f1505b99f90a4978dffd0b592fef72a68 (diff)
downloadgeiser-chez-b007b8801197325f3bd157c383bdfcace0ff57fc.tar.gz
geiser-chez-b007b8801197325f3bd157c383bdfcace0ff57fc.tar.bz2
PLT: Evaluation takes into account #lang forms.
This is useful when visiting a file that has not been loaded: the evaluation namespace is provided by its #lang, if any. While i was at it, i also refactored the mess in geiser:load-file.
Diffstat (limited to 'scheme/plt/geiser')
-rw-r--r--scheme/plt/geiser/eval.ss23
-rw-r--r--scheme/plt/geiser/modules.ss34
2 files changed, 31 insertions, 26 deletions
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)