Port to OCaml 5.1 (#435)

Co-authored-by: Kate <[email protected]>
realworldocaml · Sep 20, 2023 · edfb3d6 · edfb3d6
1 parent f9941da
commit edfb3d6
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 16 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -2,6 +2,8 @@
 
 #### Added
 
+- Make MDX compatible with OCaml 5.1 (#435, @polytypic and @kit-ty-kate)
+
 #### Changed
 
 #### Deprecated

diff --git a/lib/top/compat_top.ml b/lib/top/compat_top.ml
@@ -264,3 +264,19 @@ let redirect_directive directive =
   | "untrace_all" -> mdx_untrace_all
 #endif
   | v -> v
+
+let rec get_id_in_path = function
+  | Path.Pident id -> id
+  | Path.Pdot (p, _) -> get_id_in_path p
+  | Path.Papply (_, p) -> get_id_in_path p
+#if OCAML_VERSION >= (5, 1, 0)
+  | Path.Pextra_ty (p, _) -> get_id_in_path p
+#endif
+
+let get_id_opt = function
+  | Path.Pident id -> Some id
+  | Path.Pdot _ -> None
+  | Path.Papply _ -> None
+#if OCAML_VERSION >= (5, 1, 0)
+  | Path.Pextra_ty _ -> None
+#endif
diff --git a/lib/top/compat_top.mli b/lib/top/compat_top.mli
@@ -67,3 +67,5 @@ val execute_phrase :
 
 (* If the directive has to be intercepted, this function will return the new name of the directive *)
 val redirect_directive : string -> string
+val get_id_in_path : Path.t -> Ident.t
+val get_id_opt : Path.t -> Ident.t option
diff --git a/lib/top/mdx_top.ml b/lib/top/mdx_top.ml
@@ -214,11 +214,6 @@ module Rewrite = struct
         | _ -> path)
     | _ -> path
 
-  let rec get_id_in_path = function
-    | Path.Pident id -> id
-    | Path.Pdot (p, _) -> get_id_in_path p
-    | Path.Papply (_, p) -> get_id_in_path p
-
   let is_persistent_value env longident =
     let is_persistent_path p = Ident.persistent (get_id_in_path p) in
     try is_persistent_path (fst (Compat_top.lookup_value longident env))
@@ -701,9 +696,9 @@ let rec save_summary acc s =
     ~module_:(fun summary id ~present ->
       match present with true -> add summary id | false -> acc)
     ~open_:(fun summary x ->
-      match x with
-      | Pident id -> add summary id
-      | Pdot _ | Papply _ -> default_case summary)
+      match get_id_opt x with
+      | Some id -> add summary id
+      | None -> default_case summary)
     ~class_:add ~functor_arg:add ~extension:add
     ~empty:(fun () -> acc)
     ~constraints:default_case ~cltype:default_case ~modtype:default_case

diff --git a/test/bin/mdx-test/expect/errors/test-case.md b/test/bin/mdx-test/expect/errors/test-case.md
@@ -53,14 +53,6 @@ Error: This expression has type string but an expression was expected of type
          int
 ```
 
-```ocaml version>=4.08
-# let x =
-  1 + "42";;
-Line 2, characters 7-11:
-Error: This expression has type string but an expression was expected of type
-         int
-```
-
 ```ocaml non-deterministic=output
 # raise Not_found;;
 Exception: Not_found.
@@ -71,3 +63,11 @@ Exception: Not_found.
 first
 Exception: Failure "second".
 ```
+
+```ocaml version>=4.08
+# let x =
+  1 + "42";;
+Line 2, characters 7-11:
+Error: This expression has type string but an expression was expected of type
+         int
+```