diff options
author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-17 00:44:11 +0100 |
---|---|---|
committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-17 00:44:11 +0100 |
commit | 08ba036c3056c3e5611c0fbf630bf7f08c525192 (patch) | |
tree | 30dde59bcf9e9871cac2af6091b1d6a78204e630 | |
parent | a64467da658c51b7a282a21b61e6f6fc19f592c4 (diff) | |
download | geiser-guile-08ba036c3056c3e5611c0fbf630bf7f08c525192.tar.gz geiser-guile-08ba036c3056c3e5611c0fbf630bf7f08c525192.tar.bz2 |
Separate commands for evaluation and compilation.
-rw-r--r-- | geiser/eval.scm | 33 |
1 files changed, 29 insertions, 4 deletions
diff --git a/geiser/eval.scm b/geiser/eval.scm index a74bf29..fc5d7bd 100644 --- a/geiser/eval.scm +++ b/geiser/eval.scm @@ -25,7 +25,7 @@ ;;; Code: (define-module (geiser eval) - #:export (eval-in comp-file load-file) + #:export (eval-in compile-in comp-file load-file) #:use-module (srfi srfi-1) #:no-backtrace) @@ -45,13 +45,38 @@ SUBR, MSG and REST." (output (with-output-to-string (lambda () + (set! result (eval form module)))))) + (make-result result output))) + error-handler))) + +(define (compile-in form module-name) + "Compiles @var{form} in the module designated by @var{module-name}. +If @var{module-name} is @var{#f} or resolution fails, the current module is used instead. +The result is a list of the form ((RESULT . <form-value>) (OUTPUT . <string>)) +if no evaluation error happens, or ((ERROR (KEY . <error-key>) <error-arg>...)) +in case of errors. Each error arg is a cons (NAME . VALUE), where NAME includes +SUBR, MSG and REST." + (let ((module (or (and (list? module-name) + (resolve-module module-name)) + (current-module)))) + (catch #t + (lambda () + (let* ((result #f) + (output + (with-output-to-string + (lambda () (save-module-excursion (lambda () (set-current-module module) (set! result (compile form)))))))) - (list (cons 'result result) (cons 'output output)))) - (lambda (key . args) - (list (cons 'error (apply parse-error (cons key args)))))))) + (make-result result output))) + error-handler))) + +(define (make-result result output) + (list (cons 'result result) (cons 'output output))) + +(define (error-handler key . args) + (list (cons 'error (apply parse-error (cons key args))))) (define (parse-error key . args) (let* ((len (length args)) |