LCP: SLIME debugging support when used as a tool

Reviewers: teon.banek

Reviewed By: teon.banek

Subscribers: pullbot

Differential Revision: https://phabricator.memgraph.io/D1929

src/lisp/CMakeLists.txt

@@ -10,6 +10,7 @@ set(lcp_src_files
     ${CMAKE_SOURCE_DIR}/src/lisp/code-gen.lisp
     ${CMAKE_SOURCE_DIR}/src/lisp/slk.lisp
     ${CMAKE_SOURCE_DIR}/src/lisp/lcp.lisp
+    ${CMAKE_SOURCE_DIR}/src/lisp/debug.lisp
     ${CMAKE_SOURCE_DIR}/src/lisp/lcp-test.lisp
     ${CMAKE_SOURCE_DIR}/tools/lcp)
 
@@ -59,6 +60,7 @@ macro(define_add_lcp name main_src_files generated_lcp_files)
         ${CMAKE_SOURCE_DIR}/src/lisp/slk.lisp
         ${CMAKE_SOURCE_DIR}/src/lisp/lcp.lisp
         ${CMAKE_SOURCE_DIR}/src/lisp/lcp-test.lisp
+        ${CMAKE_SOURCE_DIR}/src/lisp/debug.lisp
         ${CMAKE_SOURCE_DIR}/tools/lcp)
     add_custom_command(OUTPUT ${h_file} ${cpp_file}
       COMMAND ${CMAKE_SOURCE_DIR}/tools/lcp ${lcp_file} ${slk_serialize}

src/lisp/debug.lisp

@@ -0,0 +1,48 @@
+(defpackage #:lcp.debug
+  (:use #:cl #:lcp)
+  (:export #:lcp-debugger-hook))
+
+(in-package #:lcp.debug)
+
+(defparameter *swank-port* 4010
+  "A port on which the Swank server should be started.")
+
+(defun swank-started-p ()
+  "Test whether at least one Swank server was started."
+  (and swank::*servers* t))
+
+(defun swank-has-connections-p ()
+  "Test whether at least one SLIME connection is still alive."
+  (and swank::*connections* t))
+
+(defun invoke-slime-debugger (condition)
+  "Invoke the SLIME debugger if at least one SLIME connection is active.
+Otherwise invoke the standard debugger."
+  (let ((*debugger-hook* #'swank:swank-debugger-hook))
+    (invoke-debugger condition)))
+
+(defun lcp-debugger-hook (condition hook)
+  "This debugger hook will start a Swank server in order to facilitate the
+debugging of Lisp images which were not started with Swank running.
+
+Upon first invocation of this hook, a Swank server will be started on the port
+equal to the value of *SWANK-PORT*. Then, the restart SLIME-DEBUGGER will be
+established and the standard debugger will be invoked.
+
+Before invoking the SLIME-DEBUGGER restart the user should connect to the
+started Swank server using SLIME. If the restart is invoked and no connections
+exist, the standard debugger is invoked.
+
+If this hook is called and Swank connections already exist, the SLIME debugger
+is immediately entered without establishing any restarts."
+  (declare (ignore hook))
+  (if (swank-has-connections-p)
+      (invoke-slime-debugger condition)
+      (progn
+        (unless (swank-started-p)
+          (swank:create-server :port *swank-port* :dont-close t))
+        (restart-case (invoke-debugger condition)
+          (slime-debugger ()
+            :report (lambda (stream)
+                      (format stream "SLIME debugger (port ~S)" *swank-port*))
+            (invoke-slime-debugger condition))))))

src/lisp/lcp-compile

@@ -9,4 +9,4 @@ echo \
 "
 (load \"${quicklisp_install_dir}/setup.lisp\")
 (ql:quickload :lcp :silent t)
-" | sbcl --script
+" | sbcl --script

src/lisp/lcp.asd

@@ -2,7 +2,7 @@
   :description "LCP: The Lisp C++ Preprocessor"
   :version "0.0.1"
   :author "Teon Banek <teon.banek@memgraph.io>"
-  :depends-on ("cl-ppcre" "named-readtables")
+  :depends-on ("cl-ppcre" "named-readtables" "swank")
   :serial t
   :components ((:file "package")
                (:file "reader")
@@ -10,7 +10,8 @@
                (:file "code-gen")
                (:file "slk")
                (:file "clone")
-               (:file "lcp"))
+               (:file "lcp")
+               (:file "debug"))
   :in-order-to ((test-op (test-op "lcp/test"))))
 
 (defsystem "lcp/test"

tools/lcp

@@ -1,12 +1,18 @@
 #!/bin/bash -e
 
-if [[ $# -ne 1 && $# -ne 2 ]]; then
-  echo "Usage: $0 LCP_FILE"
+if [[ ! ($# -ge 1 && $# -le 3) ]]; then
+  echo "Usage: $0 [--debug] LCP_FILE [SLK_SERIALIZE]"
   echo "Convert a LCP_FILE to C++ header file and output to stdout."
   echo "If SLK_SERIALIZE is provided, then SLK serialization is generated."
   exit 1
 fi
 
+debug=false
+if [[ "$1" == "--debug" ]]; then
+  debug=true
+  shift
+fi
+
 if [[ ! -r "$1" ]]; then
   echo "File '$1' doesn't exist or isn't readable"
   exit 1
@@ -25,12 +31,22 @@ if [[ "$2" == "SLK_SERIALIZE" ]]; then
   slk_serialize=":slk-serialize t"
 fi
 
-echo \
-"
-(load \"${quicklisp_install_dir}/setup.lisp\")
-(ql:quickload :lcp :silent t)
-(lcp:process-file \"$lcp_file\" $slk_serialize)
-" | sbcl --script
+if [[ $debug == "true" ]]; then
+  echo \
+  "
+  (load \"${quicklisp_install_dir}/setup.lisp\")
+  (ql:quickload :lcp :silent t)
+  (let ((*debugger-hook* #'lcp.debug:lcp-debugger-hook))
+    (lcp:process-file \"$lcp_file\" $slk_serialize))
+  " | sbcl --noinform --noprint
+else
+  echo \
+  "
+  (load \"${quicklisp_install_dir}/setup.lisp\")
+  (ql:quickload :lcp :silent t)
+  (lcp:process-file \"$lcp_file\" $slk_serialize)
+  " | sbcl --script
+fi
 
 filename=`basename $lcp_file .lcp`
 hpp_file="$(dirname $lcp_file)/$filename.hpp"