Merge pull request #61 from hackwaly/ocaml-5.2

Add OCaml 5.2 support

Author: sim642

.github/workflows/ci.yml

@@ -15,6 +15,7 @@ jobs:
           - ubuntu-latest
           # - macos-latest
         ocaml-compiler:
+          - ocaml-base-compiler.5.2.0~alpha1
           - 5.1.x
           - 5.0.x
           - 4.14.x

CHANGELOG.md

@@ -1,3 +1,9 @@
+## 1.3.2 - 2024-02-25
+
+### Added
+
+* Add OCaml 5.2 support (#60, #61).
+
 ## 1.3.1 - 2024-01-11
 
 ### Fixed

src/debugger/inspect/eval.ml

@@ -1,5 +1,21 @@
 open Ground
 
+[%%if ocaml_version >= (5, 2, 0)]
+let ident_find_same_heap id (compenv: Instruct.compilation_env) =
+  match compenv.ce_closure with
+  | Not_in_closure -> raise Not_found
+  | In_closure { entries; env_pos } ->
+    match Ident.find_same id entries with
+    | Free_variable pos ->
+      pos - env_pos
+    | Function _pos ->
+      (* Recursive functions seem to be unhandled *)
+      raise Not_found
+[%%else]
+let ident_find_same_heap id (compenv: Instruct.compilation_env) =
+  Ident.find_same id compenv.ce_heap
+[%%endif]
+
 let value_path scene frame path =
   let rec address scene frame path =
     let event = frame.Frame.event |> Option.get in
@@ -12,10 +28,10 @@ let value_path scene frame path =
         else
           try%lwt
             let pos = Ident.find_same id event.ev_compenv.ce_stack in
-            Scene.get_local scene frame (event.ev_stacksize - pos)
+            Scene.get_local scene frame (event.ev_stacksize - pos) (* TODO: Why subtracting from ev_stacksize? Not done in Value_scope. get_local already does that. *)
           with Not_found ->
-            let pos = Ident.find_same id event.ev_compenv.ce_heap in
-            Scene.get_environment scene frame pos )
+            let pos = ident_find_same_heap id event.ev_compenv in
+            Scene.get_environment scene frame pos)
     | Env.Adot (root, pos) ->
         let%lwt v = address scene frame path root in
         assert (Scene.is_block v);

src/debugger/inspect/value_basic.ml

@@ -81,7 +81,16 @@ let adopt scene typenv obj ty =
          type_manifest = Some body;
          type_params;
          _;
-        } -> (
+        } [@if ocaml_version < (5, 2, 0)] -> (
+            match Typenv.type_apply typenv type_params body ty_args with
+            | ty -> resolve_type ty
+            | exception Ctype.Cannot_apply -> ty)
+        | {
+         type_kind = Type_abstract _;
+         type_manifest = Some body;
+         type_params;
+         _;
+        } [@if ocaml_version >= (5, 2, 0)] -> (
             match Typenv.type_apply typenv type_params body ty_args with
             | ty -> resolve_type ty
             | exception Ctype.Cannot_apply -> ty)

src/debugger/inspect/value_scope.ml

@@ -11,19 +11,37 @@ class virtual scope_value =
     method! num_named = -1
   end
 
+[%%if ocaml_version >= (5, 2, 0)]
+let iter_compenv_heap f (compenv: Instruct.compilation_env) =
+  match compenv.ce_closure with
+  | Not_in_closure -> ()
+  | In_closure { entries; env_pos } ->
+    entries
+    |> Ident.iter (fun id (entry: Instruct.closure_entry) ->
+        match entry with
+        | Free_variable pos ->
+          f (id, pos - env_pos)
+        | Function _pos ->
+          (* Recursive functions seem to be unhandled *)
+          ()
+      )
+[%%else]
+let iter_compenv_heap f (compenv: Instruct.compilation_env) =
+  compenv.ce_heap |> Ident.iter (fun id pos -> f (id, pos))
+[%%endif]
+
 class local_scope_value ~scene ~frame ~kind () =
   let variables_and_accu_ty =
     Lazy.from_fun (fun () ->
         match frame.event with
         | None -> ([||], None)
         | Some event -> (
             let typenv = Lazy.force frame.typenv in
-            let compenv =
+            let iter f =
               match kind with
-              | `Stack -> event.ev_compenv.ce_stack
-              | `Heap -> event.ev_compenv.ce_heap
+              | `Stack -> event.ev_compenv.ce_stack |> Ident.iter (fun id pos -> f (id, pos))
+              | `Heap -> iter_compenv_heap f event.ev_compenv
             in
-            let iter f = compenv |> Ident.iter (fun id pos -> f (id, pos)) in
             ( Iter.to_list iter
               |> List.fast_sort (Compare.by (fun (_, pos) -> pos))
               |> List.to_seq

src/typenv/typenv.ml

@@ -1,18 +1,30 @@
 let persistent_env_get_search_dirs = ref ((fun _ -> assert false) : string -> string list)
 
-[%%if ocaml_version >= (5, 0, 0)]
+[%%if ocaml_version >= (5, 2, 0)]
+let load_path_init visible = Load_path.init ~auto_include:Load_path.no_auto_include ~visible ~hidden:[]
+[%%elif ocaml_version >= (5, 0, 0)]
 let load_path_init = Load_path.init ~auto_include:Load_path.no_auto_include
 [%%else]
 let load_path_init = Load_path.init
 [%%endif]
 
+[%%if ocaml_version >= (5, 2, 0)]
+let () =
+  let old_load = !Persistent_env.Persistent_signature.load in
+  Persistent_env.Persistent_signature.load := (fun ~allow_hidden ~unit_name ->
+      let search_dirs = !persistent_env_get_search_dirs unit_name in
+      load_path_init search_dirs;
+      old_load ~allow_hidden ~unit_name
+    )
+[%%else]
 let () =
   let old_load = !Persistent_env.Persistent_signature.load in
   Persistent_env.Persistent_signature.load := (fun ~unit_name ->
       let search_dirs = !persistent_env_get_search_dirs unit_name in
       load_path_init search_dirs;
       old_load ~unit_name
     )
+[%%endif]
 
 let env_extract_values path env =
   Env.fold_values (fun name _ _ acc -> name :: acc) path env []