Gud debugger support

[fakedrake]

I see that there is some support for the debugger but I haven't been able to make it work in the context of a life-size project. Would a GUD backend be interesting to the haskell-mode community?

If anyone is interested to work on this I append an attempt I made at it. It may be useful as a starting point. It has a few problems, for example it runs in a separate instance of ghci and it overrieds a bunch of gud functions. I will work on it more at some point but I wanted to see if there is interest by others.

EDIT: In short:

• Adds the possibility for GUD to set breakpoint to column (rather than just the line)
• Makes a (comint based) backed to GUD for the haskell ghci debugger.

I clarify that the backend is based on comint because that precludes reusing the haskell-interactive buffer for GUD.

;; GUD
;;
;; M-x gud-ghci<RET>stack ghci

(defun gud-display-frame ()
  "Find and obey the last filename-and-line marker from the debugger.
Obeying it means displaying in another window the specified file and line."
  (interactive)
  (flet ((col-pos (col) (save-excursion (beginning-of-line) (+ col (point)))))
    (when gud-last-frame
      (gud-set-buffer)
      ;; gud-last-frame => (file . line)
      (cond
       ((not (listp (cdr gud-last-frame)))
        (gud-display-line (car gud-last-frame) (cdr gud-last-frame)))
       ;; gud-last-frame => (file line begin-column end-column)
       ((and
         (= 4 (length gud-last-frame))
         (every #'numberp (cdr gud-last-frame)))
        (let* ((file (car gud-last-frame))
               (file-buf (find-file-noselect file t))
               (line (cadr gud-last-frame))
               (expr-begin-col (caddr gud-last-frame))
               (expr-end-col (cadddr gud-last-frame)))
          (gud-display-line file line)
          (with-current-buffer file-buf
            (let ((expr-begin (col-pos expr-begin-col))
                  (expr-end  (col-pos expr-end-col))
                  (pulse-delay .30))
              (message (concat "Expr " (buffer-substring expr-begin expr-end)))
              (pulse-momentary-highlight-region expr-begin expr-end)))))
       ;; TODO: gud-last-frame =>
       ;; (file (begin-line . begin-column) (end-line . end-column))
       ;; Anything else
       (t (error "Unknown gud-last-frame format.")))
      (setq gud-last-last-frame gud-last-frame
        gud-last-frame nil))))

(defun gud-ghci-marker-filter (string)
  (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))

  (let (start)
    ;; Process all complete markers in this chunk.
    (while (string-match
        "\\(Logged breakpoint at\\|Stopped in [^ \t\r\n]+,\\) \\(?1:[^ \t\r\n]+?\\):\\(?2:[0-9]+\\):\\(?3:[0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\|\\)"
        gud-marker-acc start)
      (setq gud-last-frame
        (list (match-string 1 gud-marker-acc)
          (string-to-number (match-string 2 gud-marker-acc))
                  (string-to-number (match-string 3 gud-marker-acc))
                  (string-to-number (match-string 4 gud-marker-acc)))
        start (match-end 0)))

    ;; Search for the last incomplete line in this chunk
    (while (string-match "\n" gud-marker-acc start)
      (setq start (match-end 0)))

    ;; If the incomplete line APPEARS to begin with another marker, keep it
    ;; in the accumulator.  Otherwise, clear the accumulator to avoid an
    ;; unnecessary concat during the next call.
    (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0))))
  string)

(defun gud-ghci (command-line)
  (interactive (list (gud-query-cmdline 'gud-ghci)))
  (require 'gud)
  (when (and gud-comint-buffer
         (buffer-name gud-comint-buffer)
         (get-buffer-process gud-comint-buffer)
         (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'ghci)))
    (gdb-restore-windows)
    (error
     "Multiple debugging requires restarting in text command mode"))

  (gud-common-init command-line nil 'gud-ghci-marker-filter)
  (setq-local gud-minor-mode 'ghci)
  (setq paragraph-start comint-prompt-regexp)
  (comint-send-string (get-buffer-process (current-buffer))
                      ":set prompt \"> \"\n:print '\\n'\n")
  (setq comint-prompt-regexp "^> ")

  (gud-def gud-break  ":break %m %l %y" "\C-b" "Set breakpoint at current line.")
  ;; TODO: put _result=... line to minibuffer.
  (gud-def gud-stepi  ":step"           "\C-s" "Step one source line with display.")
  (gud-def gud-step   ":stepmodule"     "\C-n" "Step in the module.")
  (gud-def gud-next   ":steplocal"      "n" "Step in the local scope.")
  (gud-def gud-cont   ":continue"       "\C-r" "Continue with display.")
  (gud-def gud-up     ":back"           "<" "Up one stack frame.")
  (gud-def gud-down   ":forward"        ">" "Down one stack frame.")
  (gud-def gud-run    ":trace %e"       "t" "Trace expression.")
  (gud-def gud-print  ":print %e"       "\C-p" "Evaluate Guile expression at point.")
  (run-hooks 'gud-ghci-mode-hook))

(defvar gud-ghci-command-name "stack repl")
(require 'gud)
(defun gud-format-command (str arg)
  (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
    (frame (or gud-last-frame gud-last-last-frame))
    (buffer-file-name-localized
         (and (buffer-file-name)
              (or (file-remote-p (buffer-file-name) 'localname)
                  (buffer-file-name))))
    result)
    (while (and str
        (let ((case-fold-search nil))
          (string-match "\\([^%]*\\)%\\([adefFlpcmy]\\)" str)))
      (let ((key (string-to-char (match-string 2 str)))
        subst)
    (cond
     ((eq key ?f)
      (setq subst (file-name-nondirectory (if insource
                          buffer-file-name-localized
                        (car frame)))))
     ((eq key ?F)
      (setq subst (file-name-base (if insource
                                          buffer-file-name-localized
                                        (car frame)))))
     ((eq key ?d)
      (setq subst (file-name-directory (if insource
                           buffer-file-name-localized
                         (car frame)))))
     ((eq key ?l)
      (setq subst (int-to-string
               (if insource
               (save-restriction
                 (widen)
                 (+ (count-lines (point-min) (point))
                (if (bolp) 1 0)))
             (cdr frame)))))
     ((eq key ?e)
      (setq subst (gud-find-expr)))
     ((eq key ?a)
      (setq subst (gud-read-address)))
     ((eq key ?c)
      (setq subst
                (gud-find-class
                 (if insource
                     (buffer-file-name)
                   (car frame))
                 (if insource
                     (save-restriction
                       (widen)
                       (+ (count-lines (point-min) (point))
                          (if (bolp) 1 0)))
                   (cdr frame)))))
     ((eq key ?p)
      (setq subst (if arg (int-to-string arg))))

         ;; My additions here
         ((eq key ?m)
          (setq subst
                (gud-find-module
                 (if insource
                     (buffer-file-name)
                   (car frame))
                 (if insource
                     (save-restriction
                       (widen)
                       (+ (count-lines (point-min) (point))
                          (if (bolp) 1 0)))
                   (cdr frame)))))

         ((eq key ?y)
          (setq subst
                (int-to-string
             (if insource
                 (save-restriction (widen) (current-column))
               (cdr frame))))))

    (setq result (concat result (match-string 1 str) subst)))
      (setq str (substring str (match-end 2))))
    ;; There might be text left in STR when the loop ends.
    (concat result str)))

(defun gud-find-module (f _line)
  (save-excursion
    (save-restriction
      (save-match-data
        (with-current-buffer (get-file-buffer f)
          (goto-char (point-min))
          (if (re-search-forward "^module[[:space:]]+\\([^[:space:](]+\\)" nil t nil)
              (match-string-no-properties 1)
            ""))))))

[unhammer]

Can you use this from M-x gdb?