From ad8f2f069f9cec540fc09b2c2b704211f75a3e8f Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 26 Apr 2009 16:50:10 +0200 Subject: PLT: load-file and improvements to evaluation. --- scheme/plt/geiser/eval.ss | 37 ++++++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) (limited to 'scheme/plt/geiser') diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss index 8fa5b81..49f75f1 100644 --- a/scheme/plt/geiser/eval.ss +++ b/scheme/plt/geiser/eval.ss @@ -26,20 +26,36 @@ #lang scheme -(provide eval-in compile-in set-last-result) +(provide eval-in compile-in + load-file compile-file) (require scheme/enter) (define last-result (void)) (define nowhere (open-output-nowhere)) -(define (ensure-module spec) +(define (ensure-spec spec) (cond ((symbol? spec) spec) ((not (string? spec)) #f) ((not (file-exists? spec)) #f) ((absolute-path? spec) `(file ,spec)) (else spec))) +(define (load-module spec . port) + (parameterize ((current-error-port (if (null? port) nowhere (car port)))) + (eval #`(enter! #,spec))) + (enter! #f)) + +(define (ensure-namespace mod-spec) + (letrec ((spec (ensure-spec mod-spec)) + (handler (lambda (e) + (load-module spec) + (module->namespace spec)))) + (if spec + (with-handlers ((exn:fail:contract? handler)) + (module->namespace spec)) + (current-namespace)))) + (define (exn-key e) (vector-ref (struct->vector e) 0)) @@ -53,13 +69,20 @@ (define (eval-in form spec) (set-last-result (void)) (with-handlers ((exn? set-last-error)) - (parameterize ((current-error-port nowhere)) - (eval #`(enter! #,(ensure-module spec)))) - ((dynamic-require '(lib "geiser/eval") - 'set-last-result) (eval form))) - (enter! #f) + (set-last-result (eval form (ensure-namespace spec)))) last-result) (define compile-in eval-in) +(define (load-file file) + (with-handlers ((exn? set-last-error)) + (set-last-result + (string-append (with-output-to-string + (lambda () + (load-module (ensure-spec file) (current-output-port)))) + "done."))) + last-result) + +(define compile-file load-file) + ;;; eval.ss ends here -- cgit v1.2.3