diff options
| -rw-r--r-- | elisp/geiser-eval.el | 7 | ||||
| -rw-r--r-- | scheme/geiser/eval.scm | 22 |
2 files changed, 24 insertions, 5 deletions
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 74c9b29..8466a36 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -104,8 +104,13 @@ (defsubst geiser-eval--retort-p (ret) (and (listp ret) (or (assoc 'error ret) (assoc 'result ret)))) -(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) (defsubst geiser-eval--retort-result (ret) (cdr (assoc 'result ret))) +(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) + +(defsubst geiser-eval--error-key (err) (cdr (assoc 'key err))) +(defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err))) +(defsubst geiser-eval--error-msg (err) (cdr (assoc 'msg err))) +(defsubst geiser-eval--error-rest (err) (cdr (assoc 'rest err))) (provide 'geiser-eval) diff --git a/scheme/geiser/eval.scm b/scheme/geiser/eval.scm index 3e800c9..81b2647 100644 --- a/scheme/geiser/eval.scm +++ b/scheme/geiser/eval.scm @@ -25,18 +25,32 @@ ;;; Code: (define-module (geiser eval) - #:export (eval-in)) + #:export (eval-in) + #:use-module (srfi srfi-1)) (define (eval-in form module-name) "Evals FORM in the module designated by MODULE-NAME. If MODULE-NAME is #f or resolution fails, the current module is used instead. The result is a list of the form ((RESULT . <form-value>)) -if no evaluation error happens, or ((ERROR <error-key> <error-arg>...)) -in case of errors." +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 module-name (resolve-module module-name)) (current-module)))) (catch #t (lambda () (list (cons 'result (eval form module)))) - (lambda (key . args) (list (cons 'error (cons key args))))))) + (lambda (key . args) + (list (cons 'error (apply parse-error (cons key args)))))))) + +(define (parse-error key . args) + (let* ((len (length args)) + (subr (and (> len 0) (first args))) + (msg (and (> len 1) (second args))) + (margs (and (> len 2) (third args))) + (rest (and (> len 3) (fourth args)))) + (list (cons 'key key) + (cons 'subr (or subr '())) + (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '())) + (cons 'rest (or rest '()))))) ;;; eval.scm ends here |