From 90835ae8e3ad9763e1a8d1135e337c0855ec3daf Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sun, 6 Jun 2010 19:28:36 +0200
Subject: Guile: new evaluation strategy that really delimits stack frames.

---
 geiser/evaluation.scm | 32 +++++++++++++++++++++-----------
 1 file changed, 21 insertions(+), 11 deletions(-)

(limited to 'geiser')

diff --git a/geiser/evaluation.scm b/geiser/evaluation.scm
index 7f2b8f7..179e425 100644
--- a/geiser/evaluation.scm
+++ b/geiser/evaluation.scm
@@ -16,10 +16,10 @@
             ge:compile-file
             ge:load-file)
   #:use-module (srfi srfi-1)
+  #:use-module (language tree-il)
   #:use-module (system base compile)
   #:use-module (system base pmatch)
   #:use-module (system vm program)
-  #:use-module (language tree-il)
   #:use-module (ice-9 pretty-print))
 
 (define (handle-error stack . args)
@@ -40,25 +40,35 @@
              (beautify-user-module! m)
              m))))
 
+(define (write-result result output)
+  (write (list (cons 'result result) (cons 'output output)))
+  (newline))
+
 (define (ge:compile form module-name)
   (let* ((module (or (find-module module-name) (current-module)))
          (result #f)
          (ev (lambda ()
-               (set! result (call-with-values
-                                (lambda ()
-                                  (start-stack 'geiser-evaluation-stack
-                                               (compile form #:env module)))
-                              (lambda vs (map object->string vs)))))))
+               (set! result
+                     (call-with-values
+                         (lambda ()
+                           (let* ((o (compile form
+                                              #:to 'objcode #:env module))
+                                  (thunk (make-program o)))
+                             (start-stack 'geiser-evaluation-stack
+                                          (eval `(,thunk) module))))
+                       (lambda vs (map object->string vs)))))))
     (let ((output (with-output-to-string ev)))
-      (write `(,(cons 'result result) (output . ,output)))
-      (newline))))
+      (write-result result output))))
 
 (define ge:eval ge:compile)
 
 (define (ge:compile-file path)
-  (ge:compile `(load-compiled (compile-file ,path
-                                            #:canonicalization 'absolute))
-              '(geiser evaluation)))
+  (write-result
+   (let ((cr (compile-file path #:canonicalization 'absolute)))
+     (and cr
+          (list (object->string (save-module-excursion
+                                 (lambda () (load-compiled cr)))))))
+   ""))
 
 (define ge:load-file ge:compile-file)
 
-- 
cgit v1.2.3