Mercurial > hg > Members > kokubo > emacs

annotate .emacs.d/haskell-mode/haskell-debug.el @ 0:2764b4f45f9f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
1st commit
author Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
date Mon, 21 Apr 2014 04:30:59 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 ;;; haskell-debug.el --- Debugging mode via GHCi
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 ;; Copyright (c) 2014 Chris Done. All rights reserved.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 ;; This file is free software; you can redistribute it and/or modify
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 ;; it under the terms of the GNU General Public License as published by
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 ;; the Free Software Foundation; either version 3, or (at your option)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 ;; any later version.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 ;; This file is distributed in the hope that it will be useful,
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 ;; GNU General Public License for more details.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 ;; You should have received a copy of the GNU General Public License
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 ;;; Code:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 (require 'cl)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 (defmacro haskell-debug-with-breakpoints (&rest body)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 "Breakpoints need to exist to start stepping."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 `(if (haskell-debug-get-breakpoints)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 ,@body
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 (error "No breakpoints to step into!")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 (defmacro haskell-debug-with-modules (&rest body)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 "Modules need to exist to do debugging stuff."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 `(if (haskell-debug-get-modules)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 ,@body
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 (error "No modules loaded!")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
33
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
34 (define-derived-mode haskell-debug-mode
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 text-mode "Debug"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 "Major mode for debugging Haskell via GHCi.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
37
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 (define-key haskell-debug-mode-map (kbd "g") 'haskell-debug/refresh)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
39 (define-key haskell-debug-mode-map (kbd "s") 'haskell-debug/step)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 (define-key haskell-debug-mode-map (kbd "d") 'haskell-debug/delete)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 (define-key haskell-debug-mode-map (kbd "b") 'haskell-debug/break-on-function)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
42 (define-key haskell-debug-mode-map (kbd "a") 'haskell-debug/abandon)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 (define-key haskell-debug-mode-map (kbd "c") 'haskell-debug/continue)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 (define-key haskell-debug-mode-map (kbd "p") 'haskell-debug/previous)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 (define-key haskell-debug-mode-map (kbd "n") 'haskell-debug/next)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 (define-key haskell-debug-mode-map (kbd "RET") 'haskell-debug/select)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
47
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
48 (defvar haskell-debug-history-cache nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 "Cache of the tracing history.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
50
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 (defvar haskell-debug-bindings-cache nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
52 "Cache of the current step's bindings.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
53
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 (defun haskell-debug-session-debugging-p (session)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
55 "Does the session have a debugging buffer open?"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 (not (not (get-buffer (haskell-debug-buffer-name session)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
57
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 (defun haskell-debug ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
59 "Start the debugger for the current Haskell (GHCi) session."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 (let ((session (haskell-session)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 (switch-to-buffer-other-window (haskell-debug-buffer-name session))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 (unless (eq major-mode 'haskell-debug-mode)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 (haskell-debug-mode)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 (haskell-debug-start session))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
66
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 (defun haskell-debug/delete ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
68 "Delete whatever's at the point."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 ((get-text-property (point) 'break)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 (let ((break (get-text-property (point) 'break)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
73 (when (y-or-n-p (format "Delete breakpoint #%d?"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 (plist-get break :number)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
75 (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
76 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
77 (format ":delete %d"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 (plist-get break :number)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 (haskell-debug/refresh))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
80
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 (defun haskell-debug/step (&optional expr)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 "Step into the next function."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 (haskell-debug-with-breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
85 (let* ((breakpoints (haskell-debug-get-breakpoints))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 (context (haskell-debug-get-context))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 (string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
88 (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 (if expr
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 (concat ":step " expr)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 ":step"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
93 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 ((string= string "not stopped at a breakpoint")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
95 (if haskell-debug-bindings-cache
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 (progn (setq haskell-debug-bindings-cache nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
97 (haskell-debug/refresh))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
98 (call-interactively 'haskell-debug/start-step)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 (t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 (maybe-stopped-at
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 (set (make-local-variable 'haskell-debug-bindings-cache)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 maybe-stopped-at)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 (message "Computation paused.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 (haskell-debug/refresh))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 (t
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 (if context
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 (message "Computation finished.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 (when (y-or-n-p "Computation completed without breaking. Reload the module and retry?")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 (message "Reloading and resetting breakpoints...")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 (haskell-interactive-mode-reset-error (haskell-session))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 (loop for break in breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 do (haskell-process-file-loadish
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 (concat "load " (plist-get break :path))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 nil))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 (loop for break in breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 do (haskell-debug-break break))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 (haskell-debug/step expr)))))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 (haskell-debug/refresh)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 (defun haskell-debug/start-step (expr)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 "Start stepping EXPR."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 (interactive (list (read-from-minibuffer "Expression to step through: ")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 (haskell-debug/step expr))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 (defun haskell-debug/refresh ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 "Refresh the debugger buffer."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 (with-current-buffer (haskell-debug-buffer-name (haskell-session))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 (let ((inhibit-read-only t)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 (p (point)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 (erase-buffer)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 (insert (propertize (concat "Debugging "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 (haskell-session-name (haskell-session))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 "\n\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
137 'face `((:weight bold))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
138 (let ((modules (haskell-debug-get-modules))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
139 (breakpoints (haskell-debug-get-breakpoints))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
140 (context (haskell-debug-get-context))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 (history (haskell-debug-get-history)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 (unless modules
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
143 (insert (propertize "You have to load a module to start debugging.\n\n"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 'face
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
145 `((:foreground ,sunburn-red)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
146 (haskell-debug-insert-bindings modules breakpoints context)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
147 (when modules
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
148 (haskell-debug-insert-current-context context history)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
149 (haskell-debug-insert-breakpoints breakpoints))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
150 (haskell-debug-insert-modules modules))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
151 (insert "\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
152 (goto-char (min (point-max) p)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
153
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
154 (defun haskell-debug-break (break)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
155 "Set BREAK breakpoint in module at line/col."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
156 (haskell-process-queue-without-filters
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
157 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
158 (format ":break %s %s %d"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
159 (plist-get break :module)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
160 (plist-get (plist-get break :span) :start-line)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
161 (plist-get (plist-get break :span) :start-col))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
162
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
163 (defun haskell-debug-insert-current-context (context history)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
164 "Insert the current context."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
165 (haskell-debug-insert-header "Context")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
166 (if context
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
167 (haskell-debug-insert-context context history)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
168 (haskell-debug-insert-debug-finished))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
169 (insert "\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
170
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
171 (defun haskell-debug-insert-debug-finished ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
172 "Insert message that no debugging is happening, but if there is
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
173 some old history, then display that."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
174 (if haskell-debug-history-cache
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
175 (progn (haskell-debug-insert-muted "Finished debugging.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
176 (insert "\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
177 (haskell-debug-insert-history haskell-debug-history-cache))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
178 (haskell-debug-insert-muted "Not debugging right now.")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
179
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
180 (defun haskell-debug-insert-context (context history)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
181 "Insert the context and history."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
182 (when context
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
183 (insert (propertize (plist-get context :name) 'face `((:weight bold)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
184 (haskell-debug-muted " - ")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
185 (file-name-nondirectory (plist-get context :path))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
186 (haskell-debug-muted " (stopped)")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
187 "\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
188 (when haskell-debug-bindings-cache
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
189 (insert "\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
190 (let ((bindings haskell-debug-bindings-cache))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
191 (insert
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
192 (haskell-debug-get-span-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
193 (plist-get bindings :path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
194 (plist-get bindings :span)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
195 (insert "\n\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
196 (loop for binding in (plist-get bindings :types)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
197 do (insert (haskell-fontify-as-mode binding 'haskell-mode)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
198 "\n"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
199 (let ((history (or history
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
200 (list (haskell-debug-make-fake-history context)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
201 (when history
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
202 (insert "\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
203 (haskell-debug-insert-history history))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
204
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
205 (defun haskell-debug-insert-history (history)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
206 "Insert tracing HISTORY."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
207 (let ((i (length history)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
208 (loop for span in history
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
209 do (let ((string (haskell-debug-get-span-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
210 (plist-get span :path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
211 (plist-get span :span)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
212 (index (plist-get span :index)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
213 (insert (propertize (format "%4d" i)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
214 'face `((:weight bold :background ,sunburn-bg+1)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
215 " "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
216 (haskell-debug-preview-span
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
217 (plist-get span :span)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
218 string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
219 t)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
220 "\n")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
221 (setq i (1- i))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
222
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
223 (defun haskell-debug-make-fake-history (context)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
224 "Make a fake history item."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
225 (list :index -1
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
226 :path (plist-get context :path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
227 :span (plist-get context :span)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
228
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
229 (defun haskell-debug-preview-span (span string &optional collapsed)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
230 "Make a one-line preview of the given expression."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
231 (with-temp-buffer
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
232 (haskell-mode)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
233 (insert string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
234 (when (/= 0 (plist-get span :start-col))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
235 (indent-rigidly (point-min)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
236 (point-max)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
237 1))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
238 (font-lock-fontify-buffer)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
239 (when (/= 0 (plist-get span :start-col))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
240 (indent-rigidly (point-min)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
241 (point-max)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
242 -1))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
243 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
244 (if collapsed
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
245 (replace-regexp-in-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
246 "\n[ ]*"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
247 (propertize " " 'face `((:background ,sunburn-bg+1)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
248 (buffer-substring (point-min)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
249 (point-max)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
250 (buffer-string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
251
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
252 (defun haskell-debug-get-span-string (path span)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
253 "Get the string from the PATH and the SPAN."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
254 (save-window-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
255 (find-file path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
256 (buffer-substring
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
257 (save-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
258 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
259 (forward-line (1- (plist-get span :start-line)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
260 (forward-char (1- (plist-get span :start-col)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
261 (point))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
262 (save-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
263 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
264 (forward-line (1- (plist-get span :end-line)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
265 (forward-char (plist-get span :end-col))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
266 (point)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
267
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
268 (defun haskell-debug-insert-bindings (modules breakpoints context)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
269 "Insert a list of bindings."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
270 (if breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
271 (progn (haskell-debug-insert-binding "s" "step into an expression")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
272 (haskell-debug-insert-binding "b" "breakpoint" t))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
273 (progn
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
274 (when modules
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
275 (haskell-debug-insert-binding "b" "breakpoint"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
276 (when breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
277 (haskell-debug-insert-binding "s" "step into an expression" t))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
278 (when breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
279 (haskell-debug-insert-binding "d" "delete breakpoint"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
280 (when context
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
281 (haskell-debug-insert-binding "a" "abandon context")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
282 (haskell-debug-insert-binding "c" "continue" t))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
283 (when context
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
284 (haskell-debug-insert-binding "p" "previous step")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
285 (haskell-debug-insert-binding "n" "next step" t))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
286 (haskell-debug-insert-binding "g" "refresh" t)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
287 (insert "\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
288
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
289 (defun haskell-debug-insert-binding (binding desc &optional end)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
290 "Insert a helpful keybinding."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
291 (insert (propertize binding 'face `((:foreground ,sunburn-blue :weight bold)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
292 (haskell-debug-muted " - ")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
293 desc
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
294 (if end
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
295 "\n"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
296 (haskell-debug-muted ", "))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
297
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
298 (defun haskell-debug/breakpoint-numbers ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
299 "List breakpoint numbers."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
300 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
301 (let ((breakpoints (mapcar (lambda (breakpoint)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
302 (number-to-string (plist-get breakpoint :number)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
303 (haskell-debug-get-breakpoints))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
304 (if (null breakpoints)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
305 (message "No breakpoints.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
306 (message "Breakpoint(s): %s"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
307 (mapconcat #'identity
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
308 breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
309 ", ")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
310
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
311 (defun haskell-debug/abandon ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
312 "Abandon the current computation."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
313 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
314 (haskell-debug-with-breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
315 (haskell-process-queue-sync-request (haskell-process) ":abandon")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
316 (message "Computation abandoned.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
317 (setq haskell-debug-history-cache nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
318 (setq haskell-debug-bindings-cache nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
319 (haskell-debug/refresh)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
320
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
321 (defun haskell-debug/continue ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
322 "Continue the current computation."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
323 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
324 (haskell-debug-with-breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
325 (haskell-process-queue-sync-request (haskell-process) ":continue")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
326 (message "Computation continued.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
327 (setq haskell-debug-history-cache nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
328 (setq haskell-debug-bindings-cache nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
329 (haskell-debug/refresh)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
330
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
331 (defun haskell-debug/break-on-function ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
332 "Break on function IDENT."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
333 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
334 (haskell-debug-with-modules
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
335 (let ((ident (read-from-minibuffer "Function: "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
336 (haskell-ident-at-point))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
337 (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
338 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
339 (concat ":break "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
340 ident))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
341 (message "Breaking on function: %s" ident)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
342 (haskell-debug/refresh))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
343
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
344 (defun haskell-debug/select ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
345 "Select whatever is at point."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
346 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
347 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
348 ((get-text-property (point) 'break)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
349 (let ((break (get-text-property (point) 'break)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
350 (haskell-debug-highlight (plist-get break :path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
351 (plist-get break :span))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
352 ((get-text-property (point) 'module)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
353 (let ((break (get-text-property (point) 'module)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
354 (haskell-debug-highlight (plist-get break :path))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
355
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
356 (defun haskell-debug/next ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
357 "Go to next step to inspect bindings."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
358 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
359 (haskell-debug-with-breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
360 (haskell-debug-navigate "forward")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
361
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
362 (defun haskell-debug/previous ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
363 "Go to previous step to inspect the bindings."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
364 (interactive)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
365 (haskell-debug-with-breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
366 (haskell-debug-navigate "back")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
367
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
368 (defun haskell-debug-highlight (path &optional span)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
369 "Highlight the file at span."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
370 (let ((p (make-overlay
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
371 (line-beginning-position)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
372 (line-end-position))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
373 (overlay-put p 'face `((:background ,sunburn-bg+1)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
374 (with-current-buffer
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
375 (if span
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
376 (save-window-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
377 (find-file path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
378 (current-buffer))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
379 (find-file path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
380 (current-buffer))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
381 (let ((o (when span
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
382 (make-overlay
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
383 (save-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
384 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
385 (forward-line (1- (plist-get span :start-line)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
386 (forward-char (1- (plist-get span :start-col)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
387 (point))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
388 (save-excursion
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
389 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
390 (forward-line (1- (plist-get span :end-line)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
391 (forward-char (plist-get span :end-col))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
392 (point))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
393 (when o
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
394 (overlay-put o 'face `((:background ,sunburn-bg+1))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
395 (sit-for 0.5)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
396 (when o
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
397 (delete-overlay o))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
398 (delete-overlay p)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
399
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
400 (defun haskell-debug-insert-modules (modules)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
401 "Insert the list of modules."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
402 (haskell-debug-insert-header "Modules")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
403 (if (null modules)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
404 (haskell-debug-insert-muted "No loaded modules.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
405 (progn (loop for module in modules
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
406 do (insert (propertize (plist-get module :module)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
407 'module module
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
408 'face `((:weight bold)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
409 (haskell-debug-muted " - ")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
410 (propertize (file-name-nondirectory (plist-get module :path))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
411 'module module)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
412 (insert "\n"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
413
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
414 (defun haskell-debug-insert-header (title)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
415 "Insert a header title."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
416 (insert (propertize title
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
417 'face `((:foreground ,sunburn-green)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
418 "\n\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
419
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
420 (defun haskell-debug-insert-breakpoints (breakpoints)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
421 "Insert the list of breakpoints."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
422 (haskell-debug-insert-header "Breakpoints")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
423 (if (null breakpoints)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
424 (haskell-debug-insert-muted "No active breakpoints.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
425 (loop for break in breakpoints
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
426 do (insert (propertize (format "%d"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
427 (plist-get break :number))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
428 'face `((:weight bold))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
429 'break break)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
430 (haskell-debug-muted " - ")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
431 (propertize (plist-get break :module)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
432 'break break
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
433 'break break)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
434 (haskell-debug-muted
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
435 (format " (%d:%d)"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
436 (plist-get (plist-get break :span) :start-line)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
437 (plist-get (plist-get break :span) :start-col)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
438 "\n")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
439 (insert "\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
440
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
441 (defun haskell-debug-insert-muted (text)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
442 "Insert some muted text."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
443 (insert (haskell-debug-muted text)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
444 "\n"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
445
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
446 (defun haskell-debug-muted (text)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
447 "Make some muted text."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
448 (propertize text 'face `((:foreground ,sunburn-grey+1))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
449
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
450 (defun haskell-debug-buffer-name (session)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
451 "The debug buffer name for the current session."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
452 (format "*debug:%s*"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
453 (haskell-session-name session)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
454
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
455 (defun haskell-debug-start (session)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
456 "Start the debug mode."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
457 (setq buffer-read-only t)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
458 (haskell-session-assign session)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
459 (haskell-debug/refresh))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
460
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
461 (defun haskell-debug-get-modules ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
462 "Get the list of modules currently set."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
463 (let ((string (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
464 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
465 ":show modules")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
466 (if (string= string "")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
467 (list)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
468 (mapcar #'haskell-debug-parse-module
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
469 (split-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
470 string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
471 "\n")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
472
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
473 (defun haskell-debug-get-context ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
474 "Get the current context."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
475 (let ((string (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
476 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
477 ":show context")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
478 (if (string= string "")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
479 nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
480 (haskell-debug-parse-context string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
481
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
482 (defun haskell-debug-navigate (direction)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
483 "Navigate in DIRECTION \"back\" or \"forward\"."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
484 (let ((string (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
485 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
486 (concat ":" direction))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
487 (let ((bindings (haskell-debug-parse-logged string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
488 (set (make-local-variable 'haskell-debug-bindings-cache)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
489 bindings)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
490 (when (not bindings)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
491 (message "No more %s results!" direction)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
492 (haskell-debug/refresh)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
493
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
494 (defun haskell-debug-parse-logged (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
495 "Parse the logged breakpoint."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
496 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
497 ((string= "no more logged breakpoints" string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
498 nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
499 ((string= "already at the beginning of the history" string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
500 nil)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
501 (t
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
502 (with-temp-buffer
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
503 (insert string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
504 (goto-char (point-min))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
505 (list :path (progn (search-forward " at ")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
506 (buffer-substring-no-properties
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
507 (point)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
508 (1- (search-forward ":"))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
509 :span (haskell-debug-parse-span
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
510 (buffer-substring-no-properties
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
511 (point)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
512 (line-end-position)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
513 :types (progn (forward-line)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
514 (split-string (buffer-substring-no-properties
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
515 (point)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
516 (point-max))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
517 "\n")))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
518
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
519 (defun haskell-debug-get-history ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
520 "Get the step history."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
521 (let ((string (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
522 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
523 ":history")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
524 (if (or (string= string "")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
525 (string= string "Not stopped at a breakpoint"))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
526 nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
527 (if (string= string "Empty history. Perhaps you forgot to use :trace?")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
528 nil
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
529 (let ((entries (mapcar #'haskell-debug-parse-history-entry
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
530 (remove-if (lambda (line) (string= "<end of history>" line))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
531 (split-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
532 string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
533 "\n")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
534 (set (make-local-variable 'haskell-debug-history-cache)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
535 entries)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
536 entries)))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
537
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
538 (defun haskell-debug-parse-history-entry (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
539 "Parse a history entry."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
540 (if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
541 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
542 (list :index (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
543 :name (match-string 2 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
544 :path (match-string 3 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
545 :span (haskell-debug-parse-span (match-string 4 string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
546 (error "Unable to parse history entry: %s" string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
547
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
548 (defun haskell-debug-parse-context (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
549 "Parse the context."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
550 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
551 ((string-match "^--> \\(.+\\)\n \\(.+\\)" string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
552 (let ((name (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
553 (stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
554 (list :name name
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
555 :path (plist-get stopped :path)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
556 :span (plist-get stopped :span))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
557
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
558 (defun haskell-debug-get-breakpoints ()
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
559 "Get the list of breakpoints currently set."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
560 (let ((string (haskell-process-queue-sync-request
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
561 (haskell-process)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
562 ":show breaks")))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
563 (if (string= string "No active breakpoints.")
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
564 (list)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
565 (mapcar #'haskell-debug-parse-break-point
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
566 (split-string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
567 string
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
568 "\n")))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
569
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
570 (defun haskell-debug-parse-stopped-at (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
571 "Parse the location stopped at from the given string.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
572
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
573 For example:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
574
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
575 Stopped at /home/foo/project/src/x.hs:6:25-36
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
576
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
577 "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
578 (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
579 string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
580 (when index
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
581 (list :path (match-string 1 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
582 :span (haskell-debug-parse-span (match-string 2 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
583 :types (cdr (split-string (substring string index)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
584 "\n"))))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
585
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
586 (defun haskell-debug-parse-module (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
587 "Parse a module and path.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
588
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
589 For example:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
590
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
591 X ( /home/foo/X.hs, interpreted )
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
592
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
593 "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
594 (if (string-match "^\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [a-z]+ )$"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
595 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
596 (list :module (match-string 1 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
597 :path (match-string 2 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
598 (error "Unable to parse module from string: %s"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
599 string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
600
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
601 (defun haskell-debug-parse-break-point (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
602 "Parse a breakpoint number, module and location from a string.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
603
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
604 For example:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
605
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
606 [13] Main /home/foo/src/x.hs:(5,1)-(6,37)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
607
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
608 "
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
609 (if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
610 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
611 (list :number (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
612 :module (match-string 2 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
613 :path (match-string 3 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
614 :span (haskell-debug-parse-span (match-string 4 string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
615 (error "Unable to parse breakpoint from string: %s"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
616 string)))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
617
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
618 (defun haskell-debug-parse-span (string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
619 "Parse a source span from a string.
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
620
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
621 Examples:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
622
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
623 (5,1)-(6,37)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
624 6:25-36
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
625 5:20
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
626
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
627 People like to make other people's lives interesting by making
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
628 variances in source span notation."
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
629 (cond
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
630 ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
631 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
632 (list :start-line (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
633 :start-col (string-to-number (match-string 2 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
634 :end-line (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
635 :end-col (string-to-number (match-string 3 string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
636 ((string-match "\\([0-9]+\\):\\([0-9]+\\)"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
637 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
638 (list :start-line (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
639 :start-col (string-to-number (match-string 2 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
640 :end-line (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
641 :end-col (string-to-number (match-string 2 string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
642 ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
643 string)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
644 (list :start-line (string-to-number (match-string 1 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
645 :start-col (string-to-number (match-string 2 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
646 :end-line (string-to-number (match-string 3 string))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
647 :end-col (string-to-number (match-string 4 string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
648 (t (error "Unable to parse source span from string: %s"
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
649 string))))
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
650
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
651 (provide 'haskell-debug)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
652
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
653 ;; Local Variables:
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
654 ;; byte-compile-warnings: (not cl-functions)
2764b4f45f9f 1st commit
Shohei KOKUBO <e105744@ie.u-ryukyu.ac.jp>
parents:
diff changeset
655 ;; End: