From ee5412e57af6f22b623cbe772fec2f0af91038d7 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 14 Jun 2009 01:23:41 +0200 Subject: Guile: better stack trace display. --- scheme/guile/geiser/evaluation.scm | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) (limited to 'scheme/guile/geiser/evaluation.scm') diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index 537e145..de08d17 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -67,7 +67,7 @@ (set! error #t) (apply handle-error captured-stack args)) (lambda args - (set! captured-stack (make-stack #t 1 13))))))))) + (set! captured-stack (make-stack #t 2 15))))))))) (write `(,(if error result (cons 'result result)) (output . ,output))) (newline)))) @@ -78,22 +78,17 @@ (set-current-module module) (compile form)))) -(define (ge:eval form module-name) - (evaluate form module-name eval)) - +(define ge:eval ge:compile) (define (ge:compile form module-name) (evaluate form module-name eval-compile)) (define (ge:compile-file path) - "Compile and load file, given its full @var{path}." - (evaluate `(and (compile-file ,path) - (load-compiled ,(compiled-file-name path))) - '(system base compile) - eval-compile)) + "Compile a file, given its full @var{path}." + (ge:compile `(compile-and-load ,path) '(geiser evaluation))) (define (ge:load-file path) "Load file, given its full @var{path}." - (evaluate `(load ,path) #f eval)) + (ge:compile `(load-compiled ,(compiled-file-name path)) '(geiser evaluation))) (define (ge:macroexpand form . all) (let ((all (and (not (null? all)) (car all)))) -- cgit v1.2.3 From c042571626977f12916d59966ea94ded44d8cf32 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 14 Jun 2009 22:05:23 +0200 Subject: Guile: Bug fix in the latest evaluation code changes. --- scheme/guile/geiser/evaluation.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'scheme/guile/geiser/evaluation.scm') diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index de08d17..3e38843 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -78,10 +78,11 @@ (set-current-module module) (compile form)))) -(define ge:eval ge:compile) (define (ge:compile form module-name) (evaluate form module-name eval-compile)) +(define ge:eval ge:compile) + (define (ge:compile-file path) "Compile a file, given its full @var{path}." (ge:compile `(compile-and-load ,path) '(geiser evaluation))) -- cgit v1.2.3 From 710d0cec8854a4e89f4948d49e614f286913f711 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 2 Jul 2009 05:29:04 +0200 Subject: Simpler, nicer, more efficient handling of evaluation results. It comes with a pony too. --- elisp/geiser-connection.el | 1 - elisp/geiser-debug.el | 10 +++++--- elisp/geiser-eval.el | 9 ++++++- elisp/geiser-syntax.el | 10 -------- scheme/guile/geiser/evaluation.scm | 51 ++++++++++++++++++-------------------- scheme/plt/geiser/eval.ss | 8 ++++-- 6 files changed, 45 insertions(+), 44 deletions(-) (limited to 'scheme/guile/geiser/evaluation.scm') diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index 0ec6405..4f8592b 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -165,7 +165,6 @@ (goto-char (point-min)) (re-search-forward "((\\(result\\|error\\)\\>") (goto-char (match-beginning 0)) - (geiser-syntax--prepare-scheme-for-elisp-reader) (let ((form (read (current-buffer)))) (if (listp form) form (error)))) (error `((error (key . geiser-con-error)) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index ec2e93e..6d795df 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -59,7 +59,7 @@ ;;; Displaying retorts -(defun geiser-debug--display-retort (what ret) +(defun geiser-debug--display-retort (what ret &optional res) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) (output (geiser-eval--retort-output ret)) @@ -69,6 +69,9 @@ (erase-buffer) (insert what) (newline 2) + (when res + (insert res) + (newline 2)) (unless (geiser-impl--display-error impl module key output) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n"))) @@ -88,10 +91,11 @@ (wrapped (if wrap (geiser-debug--wrap-region str) str)) (code `(,(if compile :comp :eval) (:scm ,wrapped))) (ret (geiser-eval--send/wait code)) + (res (geiser-eval--retort-result-str ret)) (err (geiser-eval--retort-error ret))) (when and-go (funcall and-go)) - (when (not err) (message (format "=> %S" (geiser-eval--retort-result ret)))) - (geiser-debug--display-retort str ret))) + (when (not err) (message "%s" res)) + (geiser-debug--display-retort str ret res))) (defun geiser-debug--expand-region (start end all wrap) (let* ((str (buffer-substring-no-properties start end)) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 90be67c..428d057 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -145,7 +145,14 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) (defun geiser-eval--retort-result (ret) (let ((values (cdr (assoc 'result ret)))) - (if (> (length values) 1) (cons :values values) (car values)))) + (and (stringp (car values)) + (ignore-errors (car (read-from-string (car values))))))) + +(defun geiser-eval--retort-result-str (ret) + (let ((values (cdr (assoc 'result ret)))) + (if values + (concat "=> " (mapconcat 'identity values "\n=> ")) + "(No value)")))) (defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret))) (defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index c70aacb..db1c842 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -84,16 +84,6 @@ (geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode) -(defun geiser-syntax--prepare-scheme-for-elisp-reader () - (let ((end (save-excursion - (goto-char (point-max)) - (and (re-search-backward "(output \\. \"" nil t) - (point))))) - (save-excursion - (while (re-search-forward "#(" end t) (replace-match "(vector ")) - (goto-char (point-min)) - (while (re-search-forward "#" end t) (replace-match "\\\\#"))))) - (defsubst geiser-syntax--del-sexp (arg) (let ((p (point))) (forward-sexp arg) diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index 3e38843..c2147a1 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/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) diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss index 435b73b..5ae81ed 100644 --- a/scheme/plt/geiser/eval.ss +++ b/scheme/plt/geiser/eval.ss @@ -49,8 +49,12 @@ (set! last-result `((error (key . ,(exn-key e))))) (display (exn-message e))) -(define (set-last-result v . vs) - (set! last-result `((result ,v ,@vs)))) +(define (write-value v) + (with-output-to-string + (lambda () (write v)))) + +(define (set-last-result . vs) + (set! last-result `((result ,@(map write-value vs))))) (define (eval-in form spec) (set-last-result (void)) -- cgit v1.2.3 From d3df979d3e02bc68c36a9b243881a3ad638e3af9 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Thu, 9 Jul 2009 04:45:10 +0200 Subject: Guile: unbreaking evaluation. --- scheme/guile/geiser/evaluation.scm | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'scheme/guile/geiser/evaluation.scm') diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index c2147a1..cbc088e 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -56,14 +56,15 @@ (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)))))))) + (lambda () + (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 () -- cgit v1.2.3