branch: elpa/tuareg
commit ce92fb442812e14af49a469b666f38a88869334d
Merge: f03eb1cb0c 42539997a8
Author: monnier <monn...@iro.umontreal.ca>
Commit: GitHub <nore...@github.com>

    Merge pull request #246 from SkySkimmer/break-in-wrapped-lib
    
    ocamldebug.el: support setting breakpoints in dune "wrapped" libraries
---
 ocamldebug.el | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 58 insertions(+), 1 deletion(-)

diff --git a/ocamldebug.el b/ocamldebug.el
index 7c7bc13165..47301d1a3a 100644
--- a/ocamldebug.el
+++ b/ocamldebug.el
@@ -43,6 +43,7 @@
                                                  byte-compile-current-file
                                                  buffer-file-name))))
 (require 'derived)
+(require 'seq)
 
 ;;; Variables.
 
@@ -726,8 +727,64 @@ Obeying it means displaying in another window the 
specified file and line."
 
 ;;; Miscellaneous.
 
+(defun ocamldebug--read-from-file (file)
+  "Read FILE as a list of sexps.
+If invalid syntax, return nil and message the error."
+  (with-temp-buffer
+    (save-excursion
+      (insert "(\n")
+      (insert-file-contents file)
+      (goto-char (point-max))
+      (insert "\n)\n"))
+    (condition-case err
+        (read (current-buffer))
+      ((error err)
+       (progn
+         (message "Error reading file %S: %S" file err)
+         nil)))))
+
+(defun ocamldebug--find-single-library (sexps)
+  "If list SEXPS has a single element whose `car' is \"library\", return it.
+Otherwise return `nil'."
+  (let ((libs (seq-filter (lambda (elt) (equal (car elt) 'library)) sexps)))
+    (and (null (cdr libs)) (car libs))))
+
+(defun ocamldebug--dune-library-name (lib)
+  "With LIB a dune-syntax library stanza, get its name as a string."
+  (let ((field
+         (or
+          (seq-find (lambda (field) (equal (car-safe field) 'name)) lib)
+          (seq-find (lambda (field) (equal (car-safe field) 'public\_name)) 
lib))))
+    (symbol-name (car (cdr field)))))
+
+(defun ocamldebug--upcase-first-char (arg)
+  "Set the first character of ARG to uppercase."
+  (concat (upcase (substring arg 0 1)) (substring arg 1 (length arg))))
+
 (defun ocamldebug-module-name (filename)
-  (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 
1)))
+  "Return module name for ocamldebug, taking into account dune wrapping.
+Dune wrapping means that a file `foo.ml' belonging to a dune library
+`(library bar)' will be renamed to `bar__Foo.ml' during compilation
+and a file `bar.ml' containing `module Foo = Bar__Foo' will be generated.
+See also https://dune.readthedocs.io/en/latest/dune-files.html
+
+(for now only understands dune files with a single library stanza)"
+  (let ((mod
+         (substring
+          filename
+          (string-match "\\([^/]*\\)\\.ml$" filename)
+          (match-end 1)))
+        (dune (expand-file-name "dune" (file-name-directory filename))))
+    (if (file-exists-p dune)
+        (let* ((contents (ocamldebug--read-from-file dune))
+               (lib (and contents (ocamldebug--find-single-library contents)))
+               (is-wrapped
+                (and lib (null (seq-contains-p lib '(wrapped false)))))
+               (libname (and is-wrapped (ocamldebug--dune-library-name lib))))
+          (if libname
+              (concat libname "__" (ocamldebug--upcase-first-char mod))
+            mod))
+      mod)))
 
 ;; The ocamldebug-call function must do the right thing whether its
 ;; invoking keystroke is from the ocamldebug buffer itself (via

Reply via email to