From 6e89d965f1b0a8329ddc012feb36fd43c591acbf Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 17 Feb 2009 00:44:11 +0100
Subject: Separate commands for evaluation and compilation.

---
 scheme/guile/geiser/eval.scm | 33 +++++++++++++++++++++++++++++----
 1 file changed, 29 insertions(+), 4 deletions(-)

(limited to 'scheme')

diff --git a/scheme/guile/geiser/eval.scm b/scheme/guile/geiser/eval.scm
index a74bf29..fc5d7bd 100644
--- a/scheme/guile/geiser/eval.scm
+++ b/scheme/guile/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)
 
@@ -35,6 +35,26 @@ If @var{module-name} is @var{#f} or resolution fails, the current module is used
 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 ()
+                    (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))
@@ -49,9 +69,14 @@ SUBR, MSG and REST."
                      (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))
-- 
cgit v1.2.3