From 5bfb37a89a7e03919072bdce84f0ec38facded9a Mon Sep 17 00:00:00 2001 From: Andrei Odintsov Date: Mon, 5 May 2025 17:05:23 +0100 Subject: [PATCH 1/2] Test --- driver/main_args.ml | 27 ++++++++++++++------------- driver/main_args.mli | 1 + utils/clflags.ml | 11 ++--------- utils/clflags.mli | 11 ++--------- utils/load_path.ml | 21 +++++++++++---------- 5 files changed, 30 insertions(+), 41 deletions(-) diff --git a/driver/main_args.ml b/driver/main_args.ml index 09f66633d59..44df76d7d94 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -166,7 +166,7 @@ let mk_H f = \ (Like -I, but the program can not directly reference these dependencies)" let mk_libloc f = - "-libloc", Arg.String f, ":: Add .libloc directory configuration.\n\ + "-libloc", Arg.String f, " Add .libloc directory configuration.\n\ \ .libloc directory is alternative (to -I and -H flags) way of telling\n\ \ compiler where to find files. Each `.libloc` directory should have a\n\ \ structure of `.libloc//cmi-cmx`, where `` is a library name\n\ @@ -179,6 +179,10 @@ let mk_libloc f = \ directory. Difference between and is the same as\n\ \ the difference between -I and -H flags" +let mk_libloc_hidden f = + "-libloc-hidden", Arg.String f, " Same as -libloc, but adds directory to the\n\ + \ list of \"hidden\" directories (see -H for more details)" + let mk_impl f = "-impl", Arg.String f, " Compile as a .ml file" @@ -912,6 +916,7 @@ module type Common_options = sig val _I : string -> unit val _H : string -> unit val _libloc : string -> unit + val _libloc_hidden : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit @@ -1208,6 +1213,7 @@ struct mk_I F._I; mk_H F._H; mk_libloc F._libloc; + mk_libloc_hidden F._libloc_hidden; mk_impl F._impl; mk_instantiate_byt F._instantiate; mk_intf F._intf; @@ -1319,6 +1325,7 @@ struct mk_I F._I; mk_H F._H; mk_libloc F._libloc; + mk_libloc_hidden F._libloc_hidden; mk_init F._init; mk_labels F._labels; mk_alias_deps F._alias_deps; @@ -1437,6 +1444,7 @@ struct mk_I F._I; mk_H F._H; mk_libloc F._libloc; + mk_libloc_hidden F._libloc_hidden; mk_impl F._impl; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1580,6 +1588,7 @@ module Make_opttop_options (F : Opttop_options) = struct mk_I F._I; mk_H F._H; mk_libloc F._libloc; + mk_libloc_hidden F._libloc_hidden; mk_init F._init; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1688,6 +1697,7 @@ struct mk_I F._I; mk_H F._H; mk_libloc F._libloc; + mk_libloc_hidden F._libloc_hidden; mk_impl F._impl; mk_intf F._intf; mk_intf_suffix F._intf_suffix; @@ -1840,18 +1850,8 @@ module Default = struct include Common let _I dir = include_dirs := dir :: (!include_dirs) let _H dir = hidden_include_dirs := dir :: (!hidden_include_dirs) - let _libloc s = - match String.split_on_char ':' s with - | [ path; libs; hidden_libs ] -> - let split libs = - match libs |> String.split_on_char ',' with - | [ "" ] -> [] - | libs -> libs - in - let libs = split libs in - let hidden_libs = split hidden_libs in - libloc := { Libloc.path; libs; hidden_libs } :: !libloc - | _ -> Compenv.fatal "Incorrect -libloc format, expected: :,,...:,,..." + let _libloc file = libloc := file :: !libloc + let _libloc_hidden file = libloc_hidden := file :: !libloc_hidden let _color = Misc.set_or_ignore color_reader.parse color let _dlambda = set dump_lambda let _dletreclambda = set dump_letreclambda @@ -2111,6 +2111,7 @@ module Default = struct (s :: (!Odoc_global.hidden_include_dirs)) *) () let _libloc(_:string) = () + let _libloc_hidden(_:string) = () let _impl (_:string) = (* placeholder: Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s]) diff --git a/driver/main_args.mli b/driver/main_args.mli index f24279f8a10..c02977ac76e 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -23,6 +23,7 @@ module type Common_options = sig val _I : string -> unit val _H : string -> unit val _libloc : string -> unit + val _libloc_hidden : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit diff --git a/utils/clflags.ml b/utils/clflags.ml index d45417c9c20..07d553e2b62 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -44,14 +44,6 @@ and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *) let cmi_file = ref None -module Libloc = struct - type t = { - path: string; - libs: string list; - hidden_libs: string list - } -end - type profile_column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap | `Counters ] type profile_granularity_level = File_level | Function_level | Block_level type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks @@ -59,7 +51,8 @@ type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks let compile_only = ref false (* -c *) and output_name = ref (None : string option) (* -o *) and include_dirs = ref ([] : string list) (* -I *) -and libloc = ref ([] : Libloc.t list) (* -libloc *) +and libloc = ref ([] : string list) (* -libloc *) +and libloc_hidden = ref ([] : string list) (* -libloc-hidden *) and hidden_include_dirs = ref ([] : string list) (* -H *) and no_std_include = ref false (* -nostdlib *) and no_cwd = ref false (* -nocwd *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 8b4fca2c3b4..6f085d7ddae 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -51,14 +51,6 @@ val set_int_arg : val set_float_arg : int option -> Float_arg_helper.parsed ref -> float -> float option -> unit -module Libloc : sig - type t = { - path: string; - libs: string list; - hidden_libs: string list - } -end - type profile_column = [ `Time | `Alloc | `Top_heap | `Abs_top_heap | `Counters ] type profile_granularity_level = File_level | Function_level | Block_level type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks @@ -70,7 +62,8 @@ val cmi_file : string option ref val compile_only : bool ref val output_name : string option ref val include_dirs : string list ref -val libloc : Libloc.t list ref +val libloc : string list ref +val libloc_hidden : string list ref val hidden_include_dirs : string list ref val no_std_include : bool ref val no_cwd : bool ref diff --git a/utils/load_path.ml b/utils/load_path.ml index fff46e5d5bc..0b9e8bfe70b 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -28,7 +28,7 @@ module Dir : sig val hidden : t -> bool val create : hidden:bool -> string -> t - val create_libloc : hidden:bool -> libloc:string -> string -> t + val create_libloc : hidden:bool -> libloc_file:string -> t val find : t -> string -> string option val find_normalized : t -> string -> string option @@ -94,18 +94,17 @@ end = struct loop []) ~always:(fun () -> close_in ic) - let create_libloc ~hidden ~libloc libname = - let libloc_lib_path = Filename.concat libloc libname in - let files = read_libloc_file (Filename.concat libloc_lib_path "cmi-cmx") in + let create_libloc ~hidden ~libloc_file = + let files = read_libloc_file libloc_file in let files = List.map (fun { basename; path } -> let path = if Filename.is_relative path then - (* Paths are relative to parent directory of libloc directory *) - Filename.concat (Filename.dirname libloc) path + (* Paths are relative to parent directory of libloc file *) + Filename.concat (Filename.dirname libloc_file) path else path in { basename; path }) files in - { path = libloc_lib_path; files; hidden } + { path = libloc_file; files; hidden } end type visibility = Visible | Hidden @@ -216,10 +215,12 @@ let init ~auto_include ~visible ~hidden = reset (); visible_dirs := List.rev_map (Dir.create ~hidden:false) visible; hidden_dirs := List.rev_map (Dir.create ~hidden:true) hidden; - List.iter (fun (libloc : Clflags.Libloc.t) -> - visible_dirs := Misc.rev_map_end (fun lib -> Dir.create_libloc ~hidden:false ~libloc:libloc.path lib) libloc.libs !visible_dirs; - hidden_dirs := Misc.rev_map_end (fun lib -> Dir.create_libloc ~hidden:true ~libloc:libloc.path lib) libloc.hidden_libs !hidden_dirs + List.iter (fun libloc -> + visible_dirs := Dir.create_libloc ~hidden:false ~libloc_file:libloc :: !visible_dirs; ) !Clflags.libloc; + List.iter (fun libloc_hidden -> + hidden_dirs := Dir.create_libloc ~hidden:true ~libloc_file:libloc_hidden :: !hidden_dirs; + ) !Clflags.libloc_hidden; List.iter Path_cache.prepend_add !hidden_dirs; List.iter Path_cache.prepend_add !visible_dirs; auto_include_callback := auto_include From ee0f0adc29319dbed7afe7d949d909805d699e96 Mon Sep 17 00:00:00 2001 From: Andrei Odintsov Date: Wed, 7 May 2025 12:34:03 +0100 Subject: [PATCH 2/2] Change naming --- driver/main_args.ml | 61 ++++++++++++++++++++------------------------ driver/main_args.mli | 4 +-- utils/clflags.ml | 4 +-- utils/clflags.mli | 4 +-- utils/load_path.ml | 26 +++++++++---------- 5 files changed, 47 insertions(+), 52 deletions(-) diff --git a/driver/main_args.ml b/driver/main_args.ml index 44df76d7d94..154b46bc4c3 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -165,23 +165,18 @@ let mk_H f = " Add to the list of \"hidden\" include directories\n\ \ (Like -I, but the program can not directly reference these dependencies)" -let mk_libloc f = - "-libloc", Arg.String f, " Add .libloc directory configuration.\n\ - \ .libloc directory is alternative (to -I and -H flags) way of telling\n\ - \ compiler where to find files. Each `.libloc` directory should have a\n\ - \ structure of `.libloc//cmi-cmx`, where `` is a library name\n\ - \ and `cmi-cmx` is a file where each line is of format ` `\n\ - \ telling compiler that for library is accessible\n\ - \ at . If is relative, then it is relative to a parent directory\n\ - \ of a `.libloc` directory.\n\ - \ and are comma-separated lists of libraries, to let\n\ - \ compiler know which libraries should be accessible via this `.libloc`\n\ - \ directory. Difference between and is the same as\n\ - \ the difference between -I and -H flags" - -let mk_libloc_hidden f = - "-libloc-hidden", Arg.String f, " Same as -libloc, but adds directory to the\n\ - \ list of \"hidden\" directories (see -H for more details)" +let mk_I_paths f = + "-I-paths", Arg.String f, " Read list of paths that compiler can reference from\n\ + \ a given file. This option is alternative to -I flag, but lists available files\n\ + \ directly instead of adding the whole directory to the search path.\n\ + \ Each line of describes one file available to compiler and should be of\n\ + \ format ' ', which tells compiler that is available at\n\ + \ . If is relative, then it is relative to a parent directory\n\ + \ of ." + +let mk_H_paths f = + "-H-paths", Arg.String f, " Same as -I-paths, but adds given paths to the list\n\ + \ of \"hidden\" files (see -H for more details)" let mk_impl f = "-impl", Arg.String f, " Compile as a .ml file" @@ -915,8 +910,8 @@ module type Common_options = sig val _alert : string -> unit val _I : string -> unit val _H : string -> unit - val _libloc : string -> unit - val _libloc_hidden : string -> unit + val _I_paths : string -> unit + val _H_paths : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit @@ -1212,8 +1207,8 @@ struct mk_i F._i; mk_I F._I; mk_H F._H; - mk_libloc F._libloc; - mk_libloc_hidden F._libloc_hidden; + mk_I_paths F._I_paths; + mk_H_paths F._H_paths; mk_impl F._impl; mk_instantiate_byt F._instantiate; mk_intf F._intf; @@ -1324,8 +1319,8 @@ struct mk_alert F._alert; mk_I F._I; mk_H F._H; - mk_libloc F._libloc; - mk_libloc_hidden F._libloc_hidden; + mk_I_paths F._I_paths; + mk_H_paths F._H_paths; mk_init F._init; mk_labels F._labels; mk_alias_deps F._alias_deps; @@ -1443,8 +1438,8 @@ struct mk_i F._i; mk_I F._I; mk_H F._H; - mk_libloc F._libloc; - mk_libloc_hidden F._libloc_hidden; + mk_I_paths F._I_paths; + mk_H_paths F._H_paths; mk_impl F._impl; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1587,8 +1582,8 @@ module Make_opttop_options (F : Opttop_options) = struct mk_compact F._compact; mk_I F._I; mk_H F._H; - mk_libloc F._libloc; - mk_libloc_hidden F._libloc_hidden; + mk_I_paths F._I_paths; + mk_H_paths F._H_paths; mk_init F._init; mk_inline F._inline; mk_inline_toplevel F._inline_toplevel; @@ -1696,8 +1691,8 @@ struct mk_alert F._alert; mk_I F._I; mk_H F._H; - mk_libloc F._libloc; - mk_libloc_hidden F._libloc_hidden; + mk_I_paths F._I_paths; + mk_H_paths F._H_paths; mk_impl F._impl; mk_intf F._intf; mk_intf_suffix F._intf_suffix; @@ -1850,8 +1845,8 @@ module Default = struct include Common let _I dir = include_dirs := dir :: (!include_dirs) let _H dir = hidden_include_dirs := dir :: (!hidden_include_dirs) - let _libloc file = libloc := file :: !libloc - let _libloc_hidden file = libloc_hidden := file :: !libloc_hidden + let _I_paths file = include_paths_files := file :: !include_paths_files + let _H_paths file = hidden_include_paths_files := file :: !hidden_include_paths_files let _color = Misc.set_or_ignore color_reader.parse color let _dlambda = set dump_lambda let _dletreclambda = set dump_letreclambda @@ -2110,8 +2105,8 @@ module Default = struct Odoc_global.hidden_include_dirs := (s :: (!Odoc_global.hidden_include_dirs)) *) () - let _libloc(_:string) = () - let _libloc_hidden(_:string) = () + let _I_paths(_:string) = () + let _H_paths(_:string) = () let _impl (_:string) = (* placeholder: Odoc_global.files := ((!Odoc_global.files) @ [Odoc_global.Impl_file s]) diff --git a/driver/main_args.mli b/driver/main_args.mli index c02977ac76e..e2b258d71d6 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -22,8 +22,8 @@ module type Common_options = sig val _alert : string -> unit val _I : string -> unit val _H : string -> unit - val _libloc : string -> unit - val _libloc_hidden : string -> unit + val _I_paths : string -> unit + val _H_paths : string -> unit val _labels : unit -> unit val _alias_deps : unit -> unit val _no_alias_deps : unit -> unit diff --git a/utils/clflags.ml b/utils/clflags.ml index 07d553e2b62..c8a06912ac3 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -51,9 +51,9 @@ type flambda_invariant_checks = No_checks | Light_checks | Heavy_checks let compile_only = ref false (* -c *) and output_name = ref (None : string option) (* -o *) and include_dirs = ref ([] : string list) (* -I *) -and libloc = ref ([] : string list) (* -libloc *) -and libloc_hidden = ref ([] : string list) (* -libloc-hidden *) and hidden_include_dirs = ref ([] : string list) (* -H *) +and include_paths_files = ref ([] : string list) (* -I-paths *) +and hidden_include_paths_files = ref ([] : string list) (* -H-paths *) and no_std_include = ref false (* -nostdlib *) and no_cwd = ref false (* -nocwd *) and print_types = ref false (* -i *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 6f085d7ddae..708d19523fd 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -62,9 +62,9 @@ val cmi_file : string option ref val compile_only : bool ref val output_name : string option ref val include_dirs : string list ref -val libloc : string list ref -val libloc_hidden : string list ref val hidden_include_dirs : string list ref +val include_paths_files : string list ref +val hidden_include_paths_files : string list ref val no_std_include : bool ref val no_cwd : bool ref val print_types : bool ref diff --git a/utils/load_path.ml b/utils/load_path.ml index 0b9e8bfe70b..6fa72bbf0f2 100644 --- a/utils/load_path.ml +++ b/utils/load_path.ml @@ -28,7 +28,7 @@ module Dir : sig val hidden : t -> bool val create : hidden:bool -> string -> t - val create_libloc : hidden:bool -> libloc_file:string -> t + val create_from_path_list_file : hidden:bool -> path_list_file:string -> t val find : t -> string -> string option val find_normalized : t -> string -> string option @@ -80,7 +80,7 @@ end = struct |> List.map (fun basename -> { basename; path = Filename.concat path basename }) in { path; files; hidden } - let read_libloc_file path = + let read_path_list_file path = let ic = open_in path in Misc.try_finally (fun () -> @@ -94,17 +94,17 @@ end = struct loop []) ~always:(fun () -> close_in ic) - let create_libloc ~hidden ~libloc_file = - let files = read_libloc_file libloc_file in + let create_from_path_list_file ~hidden ~path_list_file = + let files = read_path_list_file path_list_file in let files = List.map (fun { basename; path } -> let path = if Filename.is_relative path then - (* Paths are relative to parent directory of libloc file *) - Filename.concat (Filename.dirname libloc_file) path + (* Paths are relative to parent directory of path list file *) + Filename.concat (Filename.dirname path_list_file) path else path in { basename; path }) files in - { path = libloc_file; files; hidden } + { path = path_list_file; files; hidden } end type visibility = Visible | Hidden @@ -215,12 +215,12 @@ let init ~auto_include ~visible ~hidden = reset (); visible_dirs := List.rev_map (Dir.create ~hidden:false) visible; hidden_dirs := List.rev_map (Dir.create ~hidden:true) hidden; - List.iter (fun libloc -> - visible_dirs := Dir.create_libloc ~hidden:false ~libloc_file:libloc :: !visible_dirs; - ) !Clflags.libloc; - List.iter (fun libloc_hidden -> - hidden_dirs := Dir.create_libloc ~hidden:true ~libloc_file:libloc_hidden :: !hidden_dirs; - ) !Clflags.libloc_hidden; + List.iter (fun path_list_file -> + visible_dirs := Dir.create_from_path_list_file ~hidden:false ~path_list_file :: !visible_dirs; + ) !Clflags.include_paths_files; + List.iter (fun path_list_file -> + hidden_dirs := Dir.create_from_path_list_file ~hidden:true ~path_list_file :: !hidden_dirs; + ) !Clflags.hidden_include_paths_files; List.iter Path_cache.prepend_add !hidden_dirs; List.iter Path_cache.prepend_add !visible_dirs; auto_include_callback := auto_include