Skip to content

Commit 48eb770

Browse files
committed
Update coqdev.el: minor fixes + better ocamldebug breakpoints in plugins/
1 parent 87f54b0 commit 48eb770

File tree

1 file changed

+68
-6
lines changed

1 file changed

+68
-6
lines changed

dev/tools/coqdev.el

Lines changed: 68 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -31,16 +31,21 @@
3131

3232
;;; Code:
3333

34+
(require 'seq)
35+
(require 'subr-x)
36+
3437
(defun coqdev-default-directory ()
3538
"Return the Coq repository containing `default-directory'."
36-
(let ((dir (locate-dominating-file default-directory "coq-core.opam")))
39+
(let ((dir (seq-some
40+
(lambda (f) (locate-dominating-file default-directory f))
41+
'("META.coq" "META.coq.in" "META.coq-core.in" "coqpp"))))
3742
(when dir (expand-file-name dir))))
3843

3944
(defun coqdev-setup-compile-command ()
4045
"Setup `compile-command' for Coq development."
4146
(let ((dir (coqdev-default-directory)))
42-
;; we add a space at the end to make it easy to add arguments (eg -j or target)
43-
(when dir (setq-local compile-command (concat "make -C " (shell-quote-argument dir) " ")))))
47+
(when dir (setq-local compile-command (concat "cd " (shell-quote-argument dir) "
48+
dune build @check # coq-core.install dev/shim/coqtop-prelude")))))
4449
(add-hook 'hack-local-variables-hook #'coqdev-setup-compile-command)
4550

4651
(defvar camldebug-command-name) ; from camldebug.el (caml package)
@@ -81,12 +86,19 @@ Note that this function is executed before _Coqproject is read if it exists."
8186
(setq-local coq-prog-name (concat dir "_build/default/dev/shim/coqtop-prelude")))))
8287
(add-hook 'hack-local-variables-hook #'coqdev-setup-proofgeneral)
8388

84-
(defvar coqdev-ocamldebug-command "dune exec dev/dune-dbg"
89+
(defvar coqdev-ocamldebug-command "dune exec -- dev/dune-dbg coqc /tmp/foo.v"
8590
"Command run by `coqdev-ocamldebug'")
8691

92+
(declare-function comint-check-proc "comint")
93+
(declare-function tuareg--split-args "tuareg")
94+
(declare-function ocamldebug-filter "ocamldebug")
95+
(declare-function ocamldebug-sentinel "ocamldebug")
96+
(declare-function ocamldebug-mode "ocamldebug")
97+
(declare-function ocamldebug-set-buffer "ocamldebug")
8798
(defun coqdev-ocamldebug ()
8899
"Runs a command in an ocamldebug buffer."
89100
(interactive)
101+
(require 'ocamldebug)
90102
(let* ((dir (read-directory-name "Run from directory: "
91103
(coqdev-default-directory)))
92104
(name "ocamldebug-coq")
@@ -108,7 +120,56 @@ Note that this function is executed before _Coqproject is read if it exists."
108120
(set-process-sentinel (get-buffer-process (current-buffer))
109121
#'ocamldebug-sentinel)
110122
(ocamldebug-mode)))
111-
(ocamldebug-set-buffer)))
123+
(ocamldebug-set-buffer)
124+
(insert "source dune_db_409")))
125+
126+
;; Provide correct breakpoint setting in dune wrapped libraries
127+
;; (assuming only 1 library/dune file)
128+
(defun coqdev--read-from-file (file)
129+
"Read FILE as a list of sexps. If invalid syntax, return nil and message the error."
130+
(with-temp-buffer
131+
(save-excursion
132+
(insert "(\n")
133+
(insert-file-contents file)
134+
(goto-char (point-max))
135+
(insert "\n)\n"))
136+
(condition-case err
137+
(read (current-buffer))
138+
((error err) (progn (message "Error reading file %S: %S" file err) nil)))))
139+
140+
(defun coqdev--find-single-library (sexps)
141+
"If list SEXPS has an element whose `car' is \"library\", return the first one.
142+
Otherwise return `nil'."
143+
(let ((libs (seq-filter (lambda (elt) (equal (car elt) 'library)) sexps)))
144+
(and libs (car libs))))
145+
146+
(defun coqdev--dune-library-name (lib)
147+
"With LIB a dune-syntax library stanza, get its name as a string."
148+
(let ((field (or (seq-find (lambda (field) (and (consp field) (equal (car field) 'name))) lib)
149+
(seq-find (lambda (field) (and (consp field) (equal (car field) 'public\_name))) lib))))
150+
(symbol-name (car (cdr field)))))
151+
152+
(defun coqdev--upcase-first-char (arg)
153+
"Set the first character of ARG to uppercase."
154+
(concat (upcase (substring arg 0 1)) (substring arg 1 (length arg))))
155+
156+
(defun coqdev--real-module-name (filename)
157+
"Return module name for ocamldebug, taking into account dune wrapping.
158+
(for now only understands dune files with a single library stanza)"
159+
(let ((mod (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1)))
160+
(dune (concat (file-name-directory filename) "dune")))
161+
(if (file-exists-p dune)
162+
(if-let* ((contents (coqdev--read-from-file dune))
163+
(lib (coqdev--find-single-library contents))
164+
(is-wrapped (null (seq-contains-p lib '(wrapped false))))
165+
(libname (coqdev--dune-library-name lib)))
166+
(concat libname "__" (coqdev--upcase-first-char mod))
167+
mod)
168+
mod)))
169+
170+
(with-eval-after-load 'ocamldebug
171+
(defun ocamldebug-module-name (arg)
172+
(coqdev--real-module-name arg)))
112173

113174
;; This Elisp snippet adds a regexp parser for the format of Anomaly
114175
;; backtraces (coqc -bt ...), to the error parser of the Compilation
@@ -136,7 +197,8 @@ This does not enable `bug-reference-mode'."
136197
(let ((dir (coqdev-default-directory)))
137198
(when dir
138199
(setq-local bug-reference-bug-regexp "#\\(?2:[0-9]+\\)")
139-
(setq-local bug-reference-url-format "https://github.com/coq/coq/issues/%s"))))
200+
(setq-local bug-reference-url-format "https://github.com/coq/coq/issues/%s")
201+
(when (derived-mode-p 'prog-mode) (bug-reference-prog-mode 1)))))
140202
(add-hook 'hack-local-variables-hook #'coqdev-setup-bug-reference-mode)
141203

142204
(defun coqdev-sphinx-quote-coq-refman-region (left right &optional offset beg end)

0 commit comments

Comments
 (0)