256edcc8ea1e

Use Dissect to clean up the error handling tremendously
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 21 Aug 2016 13:34:46 +0000
parents e342c4a78a57
children 6d85d8a5d5a2
branches/tags (none)
files nrepl.asd src/evaluation.lisp src/middleware/documentation.lisp

Changes

--- a/nrepl.asd	Sun Aug 21 12:58:15 2016 +0000
+++ b/nrepl.asd	Sun Aug 21 13:34:46 2016 +0000
@@ -16,6 +16,7 @@
                #:fset
                #:cl-ppcre
                #:split-sequence
+               #:dissect
                #+sbcl :sb-introspect)
 
   :serial t
--- a/src/evaluation.lisp	Sun Aug 21 12:58:15 2016 +0000
+++ b/src/evaluation.lisp	Sun Aug 21 13:34:46 2016 +0000
@@ -1,5 +1,7 @@
 (in-package #:nrepl)
 
+(defvar *last-trace* nil)
+
 (define-condition evaluation-error (error)
   ((text :initarg :text :reader text)
    (orig :initarg :orig :reader orig)
@@ -60,34 +62,34 @@
                     :orig e)))
     code))
 
-(defun clean-backtrace (backtrace)
-  (format nil "~{~A~^~%~}"
-          (loop :for line :in (split-sequence:split-sequence #\newline backtrace)
-                :until (ppcre:scan "NREPL::NREPL-EVALUATE-FORM" line)
-                :collect line)))
+
+(defun parse-frame (frame)
+  (list* (dissect:call frame) (dissect:args frame)))
+
+(defun parse-stack (stack)
+  (mapcar #'parse-frame (nthcdr 1 (reverse stack))))
+
+(defun string-trace (stack)
+  (format nil "~{~S~^~%~}" (parse-stack stack)))
 
 (defun nrepl-evaluate-form (form)
   (declare (optimize (debug 3)))
-  ;im so sorry you have to see this
   (prin1-to-string
     (handler-bind
       ((error
          (lambda (err)
-           ; if we hit an error, print the backtrace to the stream before
-           ; reraising.  if we wait til later to print it, it'll be too late.
+           ; if we hit an error, get the stack trace before reraising.  if we
+           ; wait til later to print it, it'll be too late.
            (error 'evaluation-error
                   :text "Error during evaluation!"
                   :orig err
-                  :data (list
-                          "form" (prin1-to-string form)
-                          "backtrace" (clean-backtrace
-                                        #+sbcl (with-output-to-string (s)
-                                                 (sb-debug:print-backtrace
-                                                   :stream s
-                                                   :print-frame-source t
-                                                   :from :interrupted-frame))
-                                        #-sbcl "dunno"))))))
-      (eval form))))
+                  :data (let ((trace (dissect:stack)))
+                          (setf *last-trace* trace)
+                          (list
+                            "form" (prin1-to-string form)
+                            "backtrace" (string-trace trace)))))))
+      (dissect:with-truncated-stack ()
+        (eval form)))))
 
 
 (defun evaluate-forms (message forms &optional in-package)
--- a/src/middleware/documentation.lisp	Sun Aug 21 12:58:15 2016 +0000
+++ b/src/middleware/documentation.lisp	Sun Aug 21 13:34:46 2016 +0000
@@ -34,7 +34,7 @@
       ;; P:FOO -> ("P" "FOO")
       (2 (if (string= (first parts) "")
            (find-package "KEYWORD")
-           (parse-in-package in-package)))
+           (first parts)))
 
       ;; P::FOO -> ("P" "" "FOO")
       (3 (find-package (first parts)))