From bd42523b61ff81dae4bf585fc2fabda4a94d8bd3 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 3 Sep 2015 04:21:50 +0200
Subject: guile: pretty printing evaluation results (#64)

We use the same trick as chicken for guile, and pretty-print the
evaluation results before writing them.  The trick wasn't working at all
until i specified a value for the undocumented keyword parameter
`#:max-expr-width`, which makes me think i might be missing something.
---
 scheme/guile/geiser/evaluation.scm | 16 +++++++++-------
 1 file changed, 9 insertions(+), 7 deletions(-)

diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm
index 21f8772..f28fb28 100644
--- a/scheme/guile/geiser/evaluation.scm
+++ b/scheme/guile/geiser/evaluation.scm
@@ -49,9 +49,10 @@
 
 (ge:set-warnings 'none)
 
-(define (write-result result output)
-  (write (list (cons 'result result) (cons 'output output)))
-  (newline))
+(define (stringify obj)
+  (object->string obj
+                  (lambda (o . ps)
+                    (pretty-print o (car ps)  #:max-expr-width 1000))))
 
 (define (call-with-result thunk)
   (letrec* ((result #f)
@@ -61,8 +62,9 @@
                  (with-fluids ((*current-warning-port* (current-output-port))
                                (*current-warning-prefix* ""))
                    (with-error-to-port (current-output-port)
-                     (lambda () (set! result (thunk)))))))))
-    (write-result result output)))
+                     (lambda () (set! result (map stringify (thunk))))))))))
+    (write `((result ,@result) (output . ,output)))
+    (newline)))
 
 (define (ge:compile form module)
   (compile* form module compile-opts))
@@ -79,7 +81,7 @@
                             (thunk (make-program o)))
                        (start-stack 'geiser-evaluation-stack
                                     (eval `(,thunk) module))))
-                 (lambda vs (map object->string vs))))))
+                 (lambda vs vs)))))
     (call-with-result ev)))
 
 (define (ge:eval form module-name)
@@ -87,7 +89,7 @@
          (ev (lambda ()
                (call-with-values
                    (lambda () (eval form module))
-                 (lambda vs (map object->string vs))))))
+                 (lambda vs vs)))))
     (call-with-result ev)))
 
 (define (ge:compile-file path)
-- 
cgit v1.2.3