Fix an uncaught exception with OCaml 4.11.2 when translating a polymorphic type.

lang/dune

@@ -10,7 +10,7 @@
   ((:standard version)
    \
    ocaml_obj_compat_407
-   ocaml_obj_compat_410))
+   ocaml_obj_compat_409))
  (preprocess
   (pps sedlex.ppx)))
 
@@ -20,15 +20,15 @@
  (action
   (copy %{deps} %{target}))
  (enabled_if
-  (< %{ocaml_version} 4.10)))
+  (< %{ocaml_version} 4.09)))
 
 (rule
- (deps runtime/ocaml_obj_compat_410.ml)
+ (deps runtime/ocaml_obj_compat_409.ml)
  (target ocaml_obj_compat.ml)
  (action
   (copy %{deps} %{target}))
  (enabled_if
-  (>= %{ocaml_version} 4.10)))
+  (>= %{ocaml_version} 4.09)))
 
 (rule
  (target version.ml)

ocamliface/dune

@@ -8,8 +8,8 @@ let () =
   4 :: 7 :: _ -> "407"
   | 4 :: (8|9) :: _ -> "408_9"
   | 4 :: 10 :: _ -> "410"
-  | 4 :: 11 :: _ -> "411"
-  | _ -> "411"
+  | 4 :: (11|12) :: _ -> "411_12"
+  | _ -> "411_12"
   in Jbuild_plugin.V1.send (Printf.sprintf {|
 (library
  (name cduce_ocamliface)
@@ -18,7 +18,7 @@ let () =
  (modules
   (:standard
    \
-   ("mlcompat_407" mlcompat_408_9 mlcompat_410 mlcompat_411)))
+   ("mlcompat_407" mlcompat_408_9 mlcompat_410 mlcompat_411_12)))
    (flags (-open Cduce_types))
  (libraries
   cduce-types

ocamliface/mlcompat_407.ml

@@ -3,45 +3,43 @@ open Cduce_core
 
 let longident_parse = Ocaml_common.Longident.parse
 
-module Mlstub =
-struct
+module Mlstub = struct
   let noloc id = id
+
   let str_open l =
     let open Ocaml_common.Ast_helper in
     Str.open_ (Opn.mk l)
 end
 
-module Mltypes =
-struct
-let lookup_value li env =
-    Ocaml_common.Env.lookup_value li env
+module Mltypes = struct
+  open Ocaml_common
+
+  let get_path_from_mty_alias = function
+    | Types.Mty_alias (_, p) -> p
+    | _                      -> assert false
+
+  let lookup_value li env = Env.lookup_value li env
 
-let lookup_module li env =
-    Ocaml_common.Env.lookup_module ~load:true li env
+  let lookup_module li env = Env.lookup_module ~load:true li env
 
-let load_path () =
-Ocaml_common.Config.load_path := Ocaml_common.Config.standard_library :: !Cduce_loc.obj_path
-let find_in_path file =
-  Ocaml_common.Misc.find_in_path_uncap !Ocaml_common.Config.load_path file
+  let load_path () =
+    Config.load_path := Config.standard_library :: !Cduce_loc.obj_path
 
-let get_path_from_pdot e =
-match e with
-    Ocaml_common.Path.Pdot (p, _, _) -> p
-| _ -> assert false
+  let find_in_path file = Misc.find_in_path_uncap !Config.load_path file
 
-let is_sig_value_val_reg e =
-match e with
-  Ocaml_common.Types.Sig_value (_, {val_type=_;val_kind=Val_reg}) -> true
-| _ -> false
+  let get_path_from_pdot e =
+    match e with Path.Pdot (p, _, _) -> p | _ -> assert false
 
-let get_id_t_from_sig_value e =
-match e with
-   Ocaml_common.Types.Sig_value (id, {val_type=t;}) -> (id, t)
-| _ -> assert false
+  let is_sig_value_val_reg e =
+    match e with
+    | Types.Sig_value (_, { val_type = _; val_kind = Val_reg }) -> true
+    | _ -> false
 
-let get_sig_type e =
-  match e with
-   Ocaml_common.Types.Sig_type(id, t, rs) -> (id, t, rs)
-| _ -> assert false
+  let get_id_t_from_sig_value e =
+    match e with
+    | Types.Sig_value (id, { val_type = t }) -> (id, t)
+    | _ -> assert false
 
+  let get_sig_type e =
+    match e with Types.Sig_type (id, t, rs) -> (id, t, rs) | _ -> assert false
 end

ocamliface/mlcompat_408_9.ml

@@ -3,52 +3,53 @@ open Cduce_core
 
 let longident_parse = Ocaml_common.Longident.parse
 
-module Mlstub =
-struct
-let noloc id = id
-let str_open l =
-   let open Ocaml_common.Ast_helper in
-   Str.open_ (Opn.mk (Mod.ident l))
+module Mlstub = struct
+  let noloc id = id
+
+  let str_open l =
+    let open Ocaml_common.Ast_helper in
+    Str.open_ (Opn.mk (Mod.ident l))
 end
 
-module Mltypes =
-struct
-let lookup_value li env =
-    Ocaml_common.Env.lookup_value li env
+module Mltypes = struct
+  open Ocaml_common
 
-let lookup_module li env =
-    Ocaml_common.Env.lookup_module ~load:true li env
+  let get_path_from_mty_alias = function
+    | Types.Mty_alias p -> p
+    | _                 -> assert false
 
-let load_path =
-    let once = ref false in
-    function () ->
-             if !once then () else begin
-                once := true;
-                List.iter Ocaml_common.Load_path.add_dir (List.rev !Cduce_loc.obj_path);
-                Ocaml_common.Load_path.add_dir Ocaml_common.Config.standard_library
-              end
-
-let find_in_path file =
-  Ocaml_common.Misc.find_in_path_uncap (Ocaml_common.Load_path.get_paths())  file
-
-let get_path_from_pdot e =
-match e with
-    Ocaml_common.Path.Pdot (p, _) -> p
-| _ -> assert false
-
-let is_sig_value_val_reg e =
-match e with
-  Ocaml_common.Types.Sig_value (_, {val_type=_;val_kind=Val_reg}, _) -> true
-| _ -> false
-
-let get_id_t_from_sig_value e =
-match e with
-   Ocaml_common.Types.Sig_value (id, {val_type=t;}, _) -> (id, t)
-| _ -> assert false
-
-let get_sig_type e =
-  match e with
-   Ocaml_common.Types.Sig_type(id, t, rs, _) -> (id, t, rs)
-| _ -> assert false
+  let lookup_value li env = Env.lookup_value li env
 
+  let lookup_module li env = Env.lookup_module ~load:true li env
+
+  let load_path =
+    let once = ref false in
+    function
+    | () ->
+        if !once then ()
+        else begin
+          once := true;
+          List.iter Load_path.add_dir (List.rev !Cduce_loc.obj_path);
+          Load_path.add_dir Config.standard_library
+        end
+
+  let find_in_path file = Misc.find_in_path_uncap (Load_path.get_paths ()) file
+
+  let get_path_from_pdot e =
+    match e with Path.Pdot (p, _) -> p | _ -> assert false
+
+  let is_sig_value_val_reg e =
+    match e with
+    | Types.Sig_value (_, { val_type = _; val_kind = Val_reg }, _) -> true
+    | _ -> false
+
+  let get_id_t_from_sig_value e =
+    match e with
+    | Types.Sig_value (id, { val_type = t }, _) -> (id, t)
+    | _ -> assert false
+
+  let get_sig_type e =
+    match e with
+    | Types.Sig_type (id, t, rs, _) -> (id, t, rs)
+    | _ -> assert false
 end

ocamliface/mlcompat_410.ml

 (* Compatibilty for OCaml 4.10 & 4.11 *)
 open Cduce_core
+
 let longident_parse = Ocaml_common.Longident.parse
 
-module Mlstub =
-struct
-let noloc id = Some id
-let str_open l =
-   let open Ocaml_common.Ast_helper in
-   Str.open_ (Opn.mk (Mod.ident l))
+module Mlstub = struct
+  let noloc id = Some id
+
+  let str_open l =
+    let open Ocaml_common.Ast_helper in
+    Str.open_ (Opn.mk (Mod.ident l))
 end
 
-module Mltypes =
-struct
-let lookup_value li env =
-    Ocaml_common.Env.find_value_by_name li env
+module Mltypes = struct
+  open Ocaml_common
 
-let lookup_module li env =
-  let loc = Ocaml_common.Warnings.{ loc_start= Lexing.dummy_pos;
-           loc_end= Lexing.dummy_pos; 
-          loc_ghost = true }
-  in
-  Ocaml_common.Env.lookup_module_path ~use:true ~load:true ~loc:loc li env
+  let get_path_from_mty_alias = function
+    | Types.Mty_alias p -> p
+    | _                 -> assert false
 
-let load_path =
-    let once = ref false in
-    let add_dir s = 
-      Ocaml_common.Load_path.add_dir s
+  let lookup_value li env = Env.find_value_by_name li env
+
+  let lookup_module li env =
+    let loc =
+      Warnings.
+        {
+          loc_start = Lexing.dummy_pos;
+          loc_end = Lexing.dummy_pos;
+          loc_ghost = true;
+        }
     in
-    function () ->
-             if !once then () else begin
-                once := true;
-                List.iter add_dir (List.rev !Cduce_loc.obj_path);
-                add_dir Ocaml_common.Config.standard_library
-              end
-
-let find_in_path file =
-  Ocaml_common.Misc.find_in_path_uncap (Ocaml_common.Load_path.get_paths())  file
-
-let get_path_from_pdot e =
-match e with
-    Ocaml_common.Path.Pdot (p, _) -> p
-| _ -> assert false
-
-let is_sig_value_val_reg e =
-match e with
-  Ocaml_common.Types.Sig_value (_, {val_type=_;val_kind=Val_reg; _}, _) -> true
-| _ -> false
-
-let get_id_t_from_sig_value e =
-match e with
-   Ocaml_common.Types.Sig_value (id, {val_type=t; _}, _) -> (id, t)
-| _ -> assert false
-
-let get_sig_type e =
-  match e with
-   Ocaml_common.Types.Sig_type(id, t, rs, _) -> (id, t, rs)
-| _ -> assert false
+    Env.lookup_module_path ~use:true ~load:true ~loc li env
+
+  let load_path =
+    let once = ref false in
+    let add_dir s = Load_path.add_dir s in
+    function
+    | () ->
+        if !once then ()
+        else begin
+          once := true;
+          List.iter add_dir (List.rev !Cduce_loc.obj_path);
+          add_dir Config.standard_library
+        end
+
+  let find_in_path file = Misc.find_in_path_uncap (Load_path.get_paths ()) file
+
+  let get_path_from_pdot e =
+    match e with Path.Pdot (p, _) -> p | _ -> assert false
+
+  let is_sig_value_val_reg e =
+    match e with
+    | Types.Sig_value (_, { val_type = _; val_kind = Val_reg; _ }, _) -> true
+    | _ -> false
+
+  let get_id_t_from_sig_value e =
+    match e with
+    | Types.Sig_value (id, { val_type = t; _ }, _) -> (id, t)
+    | _ -> assert false
 
+  let get_sig_type e =
+    match e with
+    | Types.Sig_type (id, t, rs, _) -> (id, t, rs)
+    | _ -> assert false
 end

ocamliface/mlcompat_411.ml

-(* Compatibilty for OCaml 4.10 & 4.11 *)
+(* Compatibilty for OCaml 4.11 & 4.12 *)
 open Cduce_core
 
-let longident_parse s = Ocaml_common.Parse.longident (Lexing.from_string s)
+let longident_parse s =
+  let open Ocaml_common in
+  match String.index_opt s '.' with
+  | None -> Longident.Lident s
+  | _    -> Parse.longident (Lexing.from_string s)
 
+module Mlstub = struct
+  let noloc id = Some id
 
-module Mlstub =
-struct
-let noloc id = Some id
-let str_open l =
-   let open Ocaml_common.Ast_helper in
-   Str.open_ (Opn.mk (Mod.ident l))
+  let str_open l =
+    let open Ocaml_common.Ast_helper in
+    Str.open_ (Opn.mk (Mod.ident l))
 end
 
-module Mltypes =
-struct
-let lookup_value li env =
-    Ocaml_common.Env.find_value_by_name li env
-
-let lookup_module li env =
-let loc = Ocaml_common.Warnings.{ loc_start= Lexing.dummy_pos;
-         loc_end= Lexing.dummy_pos; 
-         loc_ghost = true }
-      in
-      Ocaml_common.Env.lookup_module_path ~use:true ~load:true ~loc:loc li env
-    
-let load_path =
+module Mltypes = struct
+  open Ocaml_common
+
+  let get_path_from_mty_alias = function
+    | Types.Mty_alias p -> p
+    | _                 -> assert false
+
+  let lookup_value li env = Env.find_value_by_name li env
+
+  let lookup_module li env =
+    let loc =
+      Warnings.
+        {
+          loc_start = Lexing.dummy_pos;
+          loc_end = Lexing.dummy_pos;
+          loc_ghost = true;
+        }
+    in
+    Env.lookup_module_path ~use:true ~load:true ~loc li env
+
+  let is_mty_alias = function Types.Mty_alias _ -> true | _ -> false
+
+  let mty_get_path = function Types.Mty_alias p -> p | _ -> assert false
+
+  let load_path =
     let once = ref false in
-    function () ->
-             if !once then () else begin
-                once := true;
-                List.iter Ocaml_common.Load_path.add_dir (List.rev !Cduce_loc.obj_path);
-                Ocaml_common.Load_path.add_dir Ocaml_common.Config.standard_library
-              end
-
-let find_in_path file =
-  Ocaml_common.Misc.find_in_path_uncap (Ocaml_common.Load_path.get_paths())  file
-
-let get_path_from_pdot e =
-match e with
-    Ocaml_common.Path.Pdot (p, _) -> p
-| _ -> assert false
-
-let is_sig_value_val_reg e =
-match e with
-  Ocaml_common.Types.Sig_value (_, {val_type=_;val_kind=Val_reg; _}, _) -> true
-| _ -> false
-
-let get_id_t_from_sig_value e =
-match e with
-   Ocaml_common.Types.Sig_value (id, {val_type=t; _}, _) -> (id, t)
-| _ -> assert false
-
-let get_sig_type e =
-  match e with
-   Ocaml_common.Types.Sig_type(id, t, rs, _) -> (id, t, rs)
-| _ -> assert false
+    function
+    | () ->
+        if !once then ()
+        else begin
+          once := true;
+          List.iter Load_path.add_dir (List.rev !Cduce_loc.obj_path);
+          Load_path.add_dir Config.standard_library
+        end
+
+  let find_in_path file = Misc.find_in_path_uncap (Load_path.get_paths ()) file
+
+  let get_path_from_pdot e =
+    match e with Path.Pdot (p, _) -> p | _ -> assert false
+
+  let is_sig_value_val_reg e =
+    match e with
+    | Types.Sig_value (_, { val_type = _; val_kind = Val_reg; _ }, _) -> true
+    | _ -> false
+
+  let get_id_t_from_sig_value e =
+    match e with
+    | Types.Sig_value (id, { val_type = t; _ }, _) -> (id, t)
+    | _ -> assert false
 
+  let get_sig_type e =
+    match e with
+    | Types.Sig_type (id, t, rs, _) -> (id, t, rs)
+    | _ -> assert false
 end

ocamliface/mlcompat_411_12.ml

+(* Compatibilty for OCaml 4.11 & 4.12 *)
+open Cduce_core
+
+let longident_parse s = Ocaml_common.Parse.longident (Lexing.from_string s)
+
+
+module Mlstub =
+struct
+let noloc id = Some id
+let str_open l =
+   let open Ocaml_common.Ast_helper in
+   Str.open_ (Opn.mk (Mod.ident l))
+end
+
+module Mltypes =
+struct
+open Ocaml_common
+let get_path_from_mty_alias = function
+| Types.Mty_alias p -> p
+| _                 -> assert false
+
+let lookup_value li env =
+    Env.find_value_by_name li env
+
+let lookup_module li env =
+let loc = Warnings.{ loc_start= Lexing.dummy_pos;
+         loc_end= Lexing.dummy_pos; 
+         loc_ghost = true }
+      in
+      Env.lookup_module_path ~use:true ~load:true ~loc:loc li env
+   
+
+let is_mty_alias = function Types.Mty_alias _ -> true | _ -> false
+let mty_get_path = function Types.Mty_alias p -> p | _ -> assert false
+let load_path =
+    let once = ref false in
+    function () ->
+             if !once then () else begin
+                once := true;
+                List.iter Load_path.add_dir (List.rev !Cduce_loc.obj_path);
+                Load_path.add_dir Config.standard_library
+              end
+
+let find_in_path file =
+  Misc.find_in_path_uncap (Load_path.get_paths())  file
+
+let get_path_from_pdot e =
+match e with
+    Path.Pdot (p, _) -> p
+| _ -> assert false
+
+let is_sig_value_val_reg e =
+match e with
+  Types.Sig_value (_, {val_type=_;val_kind=Val_reg; _}, _) -> true
+| _ -> false
+
+let get_id_t_from_sig_value e =
+match e with
+   Types.Sig_value (id, {val_type=t; _}, _) -> (id, t)
+| _ -> assert false
+
+let get_sig_type e =
+  match e with
+   Types.Sig_type(id, t, rs, _) -> (id, t, rs)
+| _ -> assert false
+
+end

ocamliface/mlstub.real.ml

@@ -75,7 +75,7 @@ and typ_descr = function
   | Builtin ("Cduce_types.Atoms.V.t", []) -> Builtin_defs.atom
   | Builtin ("unit", []) -> Sequence.nil_type
   | Builtin ("option", [ t ]) -> Sequence.option (typ t)
-  | Builtin ("Stdlib.Seq.t", [t]) -> Builtin_defs.seq_type (typ t)
+  | Builtin ("Stdlib.Seq.t", [ t ]) -> Builtin_defs.seq_type (typ t)
   | Var i -> Types.descr !vars.(i)
   | _ -> assert false
 
@@ -91,7 +91,7 @@ and variant = function
   | lab, c, Some o  ->
       Types.tuple
         (Types.cons (atom (Ocaml_common.Ident.name lab))
-         :: List.map typ (c @ [ o ]))
+        :: List.map typ (c @ [ o ]))
   | lab, c, None    ->
       Types.tuple
         (Types.cons (atom (Ocaml_common.Ident.name lab)) :: List.map typ c)
@@ -624,8 +624,7 @@ and to_ml_descr e = function
       ML.sapply "Cduce_core.Value.cduce2ocaml_option"
         [ ML.var (to_ml_fun t); e ]
   | Builtin ("Stdlib.Seq.t", [ t ]) ->
-      ML.sapply "Cduce_core.Value.cduce2ocaml_seq"
-        [ ML.var (to_ml_fun t); e ]
+      ML.sapply "Cduce_core.Value.cduce2ocaml_seq" [ ML.var (to_ml_fun t); e ]
   | Var _ -> e
   | _ -> assert false
 

ocamliface/mltypes.real.ml

@@ -15,9 +15,9 @@ let env_initial =
       ~safe_string:(Ocaml.Config.safe_string || not !Ocaml.Clflags.unsafe_string)
       ~initially_opened_module:None ~open_implicit_modules:[]
   with
-   Ocaml.Env.Error (err) ->
-    failwith @@ (Format.asprintf "%a" Ocaml.Env.report_error err) 
-  | e -> failwith @@ "Cannot intialise OCaml environment"
+  | Ocaml.Env.Error err ->
+      failwith @@ Format.asprintf "%a" Ocaml.Env.report_error err
+  | e                   -> failwith @@ "Cannot intialise OCaml environment"
 
 let ocaml_env = ref env_initial
 
@@ -330,18 +330,23 @@ let values_of_sig name sg =
       | _                       -> accu)
     [] sg
 
+let find_value n = try find_value n with 
+  PolyAbstract s -> unsupported ("polymorphic abstract type t")
+
 let load_module name =
   Mlcompat.Mltypes.load_path ();
   let li = Mlcompat.longident_parse name in
   ocaml_env := env_initial;
   let path = Mlcompat.Mltypes.lookup_module li env_initial in
   let rec loop p =
-  match (Ocaml.Env.find_module p env_initial).md_type with
-  | Ocaml.Types.Mty_signature sg -> values_of_sig name sg
-  | Ocaml.Types.Mty_alias p2 -> loop p2
-  | _ ->
-      raise (Loc.Generic (Printf.sprintf "Module %s is not a structure" name))
-  in loop path
+    match (Ocaml.Env.find_module p env_initial).md_type with
+    | Ocaml.Types.Mty_signature sg -> values_of_sig name sg
+    | Ocaml.Types.Mty_alias _ as alias ->
+        loop (Mlcompat.Mltypes.get_path_from_mty_alias alias)
+    | _ ->
+        raise (Loc.Generic (Printf.sprintf "Module %s is not a structure" name))
+  in
+  loop path
 
 let load_module name =
   try load_module name

ocamliface/mltypes.real.mli

-
 exception Error of string
 
 type t = { uid : int; mutable recurs : int; mutable def : def }
+
 and def =