diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-07-02 05:29:04 +0200 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-07-02 05:29:04 +0200 |
commit | 67905aae390b21e4f27250b79d43184c833256a4 (patch) | |
tree | b1d9ff8e484a21ad618be45703cdcd6d9ce4be08 /geiser | |
parent | 789248bf92f9e6431d83199d3d1c0023b9d25567 (diff) | |
download | geiser-guile-67905aae390b21e4f27250b79d43184c833256a4.tar.gz geiser-guile-67905aae390b21e4f27250b79d43184c833256a4.tar.bz2 |
Simpler, nicer, more efficient handling of evaluation results. It
comes with a pony too.
Diffstat (limited to 'geiser')
-rw-r--r-- | geiser/evaluation.scm | 51 |
1 files changed, 24 insertions, 27 deletions
diff --git a/geiser/evaluation.scm b/geiser/evaluation.scm index 3e38843..c2147a1 100644 --- a/geiser/evaluation.scm +++ b/geiser/evaluation.scm @@ -47,40 +47,37 @@ (else (display (format "ERROR: ~a, args: ~a" (car args) (cdr args))))) `(error (key . ,(car args)))) -(define (evaluate form module-name evaluator) - (let ((module (or (and (list? module-name) - (resolve-module module-name)) - (current-module))) - (evaluator (lambda (f m) - (call-with-values (lambda () (evaluator f m)) list))) - (result #f) - (captured-stack #f) - (error #f)) +(define (ge:compile form module-name) + (let* ((module (or (and (list? module-name) + (resolve-module module-name)) + (current-module))) + (result #f) + (captured-stack #f) + (error #f) + (ev (lambda () + (save-module-excursion + (set-current-module module) + (set! result (call-with-values + (lambda () (compile form)) + (lambda vs + (map (lambda (v) + (with-output-to-string + (lambda () (write v)))) + vs)))))))) (let ((output (with-output-to-string (lambda () - (set! result - (catch #t - (lambda () - (start-stack 'geiser-eval (evaluator form module))) - (lambda args - (set! error #t) - (apply handle-error captured-stack args)) - (lambda args - (set! captured-stack (make-stack #t 2 15))))))))) + (catch #t + (lambda () (start-stack 'geiser-eval (ev))) + (lambda args + (set! error #t) + (apply handle-error captured-stack args)) + (lambda args + (set! captured-stack (make-stack #t 2 15)))))))) (write `(,(if error result (cons 'result result)) (output . ,output))) (newline)))) -(define (eval-compile form module) - (save-module-excursion - (lambda () - (set-current-module module) - (compile form)))) - -(define (ge:compile form module-name) - (evaluate form module-name eval-compile)) - (define ge:eval ge:compile) (define (ge:compile-file path) |