From 9d6e025304ad1c965fb5712e6075af0841c81ea2 Mon Sep 17 00:00:00 2001
From: Lovro Lugovic <lovro.lugovic@memgraph.io>
Date: Fri, 10 May 2019 13:54:23 +0200
Subject: [PATCH] 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 | 2 ++
src/lisp/debug.lisp | 48 +++++++++++++++++++++++++++++++++++++++++
src/lisp/lcp-compile | 2 +-
src/lisp/lcp.asd | 5 +++--
tools/lcp | 32 ++++++++++++++++++++-------
5 files changed, 78 insertions(+), 11 deletions(-)
create mode 100644 src/lisp/debug.lisp
diff --git a/src/lisp/CMakeLists.txt b/src/lisp/CMakeLists.txt
index d54678b1c..6c2e41db7 100644
--- a/src/lisp/CMakeLists.txt
+++ b/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}
diff --git a/src/lisp/debug.lisp b/src/lisp/debug.lisp
new file mode 100644
index 000000000..2a7a134d0
--- /dev/null
+++ b/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))))))
diff --git a/src/lisp/lcp-compile b/src/lisp/lcp-compile
index dc4002f3f..2d224ebcf 100755
--- a/src/lisp/lcp-compile
+++ b/src/lisp/lcp-compile
@@ -9,4 +9,4 @@ echo \
"
(load \"${quicklisp_install_dir}/setup.lisp\")
(ql:quickload :lcp :silent t)
-" | sbcl --script
\ No newline at end of file
+" | sbcl --script
diff --git a/src/lisp/lcp.asd b/src/lisp/lcp.asd
index e8aeb47fa..ba2b7a314 100644
--- a/src/lisp/lcp.asd
+++ b/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"
diff --git a/tools/lcp b/tools/lcp
index b74f9e0ed..6eb580e5f 100755
--- a/tools/lcp
+++ b/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"