From c4aaef9ca44fd9f3aa017998fa4c5b8498fa019b Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 19 Apr 2024 10:45:03 +0200 Subject: [PATCH] Refactor Ident_env.extract_signature_type_items This separates the item extraction from the handling of visibility and of the 'hidden' flag. --- src/loader/ident_env.cppo.ml | 106 +++++++++++++++++++++++------------ 1 file changed, 69 insertions(+), 37 deletions(-) diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index ab3d157816..de809ad6b6 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -83,10 +83,34 @@ type items = | `Include of item list ] +let extract_visibility = + let open Compat in + function + | Sig_type (_, _, _, vis) + | Sig_module (_, _, _, _, vis) + | Sig_modtype (_, _, vis) + | Sig_value (_, _, vis) + | Sig_class (_, _, _, vis) + | Sig_class_type (_, _, _, vis) + | Sig_typext (_, _, _, vis) -> + vis + let rec extract_signature_type_items vis items = let open Compat in - match items with - | Sig_type(id, td, _, vis') :: rest when vis=vis' -> + match items with + | item :: rest -> + let vis' = extract_visibility item in + if vis = vis' then + let hidden = vis' = Hidden in + extract_signature_type_items_extract vis ~hidden item rest + else + extract_signature_type_items_skip vis item rest + | [] -> [] + +and extract_signature_type_items_extract vis ~hidden item rest = + let open Compat in + match item, rest with + | Sig_type(id, td, _, _), _ -> if Btype.is_row_name (Ident.name id) then extract_signature_type_items vis rest else @@ -104,56 +128,64 @@ let rec extract_signature_type_items vis items = #endif List.map (fun c -> `Constructor (c.Types.cd_id, id, Some c.cd_loc)) cstrs | Type_open -> [] in - `Type (id, vis'=Hidden, None) :: constrs @ extract_signature_type_items vis rest + `Type (id, hidden, None) :: constrs @ extract_signature_type_items vis rest + + | Sig_module(id, _, _, _, _), _ -> + `Module (id, hidden, None) :: extract_signature_type_items vis rest - | Sig_module(id, _, _, _, vis') :: rest when vis=vis' -> - `Module (id, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_modtype(id, _, _), _ -> + `ModuleType (id, hidden, None) :: extract_signature_type_items vis rest - | Sig_modtype(id, _, vis') :: rest when vis=vis' -> - `ModuleType (id, vis'=Hidden, None) :: extract_signature_type_items vis rest - - | Sig_value(id, _, vis') :: rest when vis=vis' -> - `Value (id, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_value(id, _, _), _ -> + `Value (id, hidden, None) :: extract_signature_type_items vis rest #if OCAML_VERSION < (5,1,0) - | Sig_class(id, _, _, vis') :: Sig_class_type(ty_id, _, _, _) - :: Sig_type(obj_id, _, _, _) :: Sig_type(cl_id, _, _, _) :: rest when vis=vis' -> - `Class (id, ty_id, obj_id, Some cl_id, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_class(id, _, _, _), + Sig_class_type(ty_id, _, _, _) + :: Sig_type(obj_id, _, _, _) + :: Sig_type(cl_id, _, _, _) :: _ -> + `Class (id, ty_id, obj_id, Some cl_id, hidden, None) + :: extract_signature_type_items vis rest - | Sig_class_type(id, _, _, vis') :: Sig_type(obj_id, _, _, _) - :: Sig_type(cl_id, _, _, _) :: rest when vis=vis' -> - `ClassType (id, obj_id, Some cl_id, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_class_type(id, _, _, _), + Sig_type(obj_id, _, _, _) :: Sig_type(cl_id, _, _, _) :: _ -> + `ClassType (id, obj_id, Some cl_id, hidden, None) + :: extract_signature_type_items vis rest #else - | Sig_class(id, _, _, vis') :: Sig_class_type(ty_id, _, _, _) - :: Sig_type(obj_id, _, _, _) :: rest when vis=vis' -> - `Class (id, ty_id, obj_id, None, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_class(id, _, _, _), + Sig_class_type(ty_id, _, _, _) :: Sig_type(obj_id, _, _, _) :: _ -> + `Class (id, ty_id, obj_id, None, hidden, None) + :: extract_signature_type_items vis rest - | Sig_class_type(id, _, _, vis') :: Sig_type(obj_id, _, _, _) :: rest when vis=vis' -> - `ClassType (id, obj_id, None, vis'=Hidden, None) :: extract_signature_type_items vis rest + | Sig_class_type(id, _, _, _), Sig_type(obj_id, _, _, _) :: _ -> + `ClassType (id, obj_id, None, hidden, None) + :: extract_signature_type_items vis rest #endif - | Sig_typext (id, constr, Text_exception, vis') :: rest when vis=vis' -> + | Sig_typext (id, constr, Text_exception, _), _ -> `Exception (id, Some constr.ext_loc) :: extract_signature_type_items vis rest - | Sig_typext (id, constr, _, vis') :: rest when vis=vis'-> + | Sig_typext (id, constr, _, _), _ -> `Extension (id, Some constr.ext_loc) :: extract_signature_type_items vis rest - | Sig_class_type(_, _, _, _) :: Sig_type(_, _, _, _) - :: Sig_type(_, _, _, _) :: rest - | Sig_class(_, _, _, _) :: Sig_class_type(_, _, _, _) - :: Sig_type(_, _, _, _) :: Sig_type(_, _, _, _) :: rest - | Sig_typext (_,_,_,_) :: rest - | Sig_modtype(_, _, _) :: rest - | Sig_module(_, _, _, _, _) :: rest - | Sig_type(_, _, _, _) :: rest - | Sig_value (_, _, _) :: rest -> - extract_signature_type_items vis rest + | Sig_class _, _ + | Sig_class_type _, _ -> assert false - | Sig_class _ :: _ - | Sig_class_type _ :: _ -> assert false - - | [] -> [] +and extract_signature_type_items_skip vis item rest = + let open Compat in + match item, rest with + | Sig_class_type _, Sig_type _ :: Sig_type _ :: rest + | Sig_class _, Sig_class_type _ :: Sig_type _ :: Sig_type _ :: rest + | Sig_typext _, rest + | Sig_modtype _, rest + | Sig_module _, rest + | Sig_type _, rest + | Sig_value _, rest -> + extract_signature_type_items vis rest + + | Sig_class _, _ + | Sig_class_type _, _ -> assert false #if OCAML_VERSION >= (4,8,0)