From 80ed205e38f2f3795b083b5c89ae555d1d4c99a6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 21 Feb 2018 16:18:45 +0700 Subject: [PATCH] Refactor utop module to use the new exe module --- src/gen_rules.ml | 12 +++---- src/utop.ml | 93 +++++++++++++++++++----------------------------- src/utop.mli | 28 ++++----------- 3 files changed, 49 insertions(+), 84 deletions(-) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index b26caf87..29c822de 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -870,13 +870,11 @@ module Gen(P : Params) = struct Path.Set.add (Path.relative src_dir ".") m.source_dirs }) |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope); - Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) -> - let dir = Utop.utop_exe_dir ~dir:ctx_dir in - let merlin = - executables_rules exe ~dir ~all_modules ~scope - in - Utop.add_module_rules sctx ~dir merlin.requires; - ); + Utop.setup sctx ~dir:ctx_dir ~libs:( + List.filter_map stanzas ~f:(function + | Stanza.Library lib -> Some lib + | _ -> None) + ) ~scope; Modules_partitioner.emit_warnings modules_partitioner (* +-----------------------------------------------------------------+ diff --git a/src/utop.ml b/src/utop.ml index 861ea64b..67c3ba6d 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -4,8 +4,8 @@ open Build.O open! No_io let exe_name = "utop" -let module_name = String.capitalize_ascii exe_name -let module_filename = exe_name ^ ".ml" +let main_module_name = String.capitalize_ascii exe_name +let main_module_filename = exe_name ^ ".ml" let pp_ml fmt include_dirs = let pp_include fmt = @@ -19,7 +19,7 @@ let pp_ml fmt include_dirs = Format.fprintf fmt "@.UTop_main.main ();@." let add_module_rules sctx ~dir lib_requires = - let path = Path.relative dir module_filename in + let path = Path.relative dir main_module_filename in let utop_ml = lib_requires >>^ (fun libs -> @@ -36,59 +36,6 @@ let add_module_rules sctx ~dir lib_requires = >>> Build.write_file_dyn path in Super_context.add_rule sctx utop_ml -let utop_of_libs (libs : Library.t list) = - { Executables.names = [(Loc.none, exe_name)] - ; link_executables = true - ; link_flags = Ordered_set_lang.Unexpanded.t ( - Sexp.add_loc ~loc:Loc.none - (List [ Atom "-linkall" - ; Atom "-warn-error" - ; Atom "-31" ]) - ) - ; modes = Mode.Dict.Set.of_list [Mode.Byte] - ; buildable = - { Buildable. - loc = Loc.none - ; modules = - Ordered_set_lang.t (List (Loc.none, [Atom (Loc.none, module_name)])) - ; modules_without_implementation = Ordered_set_lang.standard - ; libraries = - (Lib_dep.direct "utop") :: (List.map libs ~f:(fun lib -> - Lib_dep.direct lib.Library.name)) - ; preprocess = Preprocess_map.no_preprocessing - ; lint = Lint.no_lint - ; preprocessor_deps = [] - ; flags = Ordered_set_lang.Unexpanded.standard - ; ocamlc_flags = Ordered_set_lang.Unexpanded.standard - ; ocamlopt_flags = Ordered_set_lang.Unexpanded.standard - ; js_of_ocaml = Js_of_ocaml.default - ; gen_dot_merlin = false - } - } - -let exe_stanzas stanzas = - let libs = - List.filter_map stanzas ~f:(function - | Stanza.Library lib -> Some lib - | _ -> None - ) in - match libs with - | [] -> None - | libs -> - let all_modules = - String_map.of_alist_exn - [ module_name - , { Module. - name = module_name - ; impl = Some { Module.File. - name = module_filename - ; syntax = Module.Syntax.OCaml - } - ; intf = None - ; obj_name = "" } - ] in - Some (utop_of_libs libs, all_modules) - let utop_exe_dir ~dir = Path.relative dir ".utop" let utop_exe dir = @@ -98,3 +45,37 @@ let utop_exe dir = custom mode. We do that so that it works without hassle when generating a utop for a library with C stubs. *) |> Path.extend_basename ~suffix:(Mode.exe_ext Mode.Native) + +let setup sctx ~dir ~(libs : Library.t list) ~scope = + match libs with + | [] -> () + | lib::_ -> + let loc = lib.buildable.loc in + let modules = + String_map.singleton + main_module_name + { Module. + name = main_module_name + ; impl = Some { Module.File. + name = main_module_filename + ; syntax = Module.Syntax.OCaml + } + ; intf = None + ; obj_name = "" } in + let utop_exe_dir = utop_exe_dir ~dir in + let _obj_dir, libs = + Exe.build_and_link sctx + ~loc + ~dir:utop_exe_dir + ~program:{ name = exe_name ; main_module_name } + ~modules + ~scope + ~linkages:[Exe.Linkage.custom] + ~libraries:( + Lib_dep.direct "utop":: + (List.map ~f:(fun (lib : Library.t) -> + Lib_dep.direct lib.name) libs) + ) + ~link_flags:(Build.return ["-linkall"; "-warn-error"; "-31"]) + in + add_module_rules sctx ~dir:utop_exe_dir libs diff --git a/src/utop.mli b/src/utop.mli index 3428bfdd..6feabfe1 100644 --- a/src/utop.mli +++ b/src/utop.mli @@ -1,26 +1,12 @@ (** Utop rules *) -open Import - -val exe_stanzas - : Jbuild.Stanza.t list - -> (Jbuild.Executables.t * Module.t String_map.t) option -(** Given a list of stanzas (from a directory with a jbuild file) return: - 1. a stanza for a utop toplevel with all the libraries linked in. - 2. an entry module that will be used to create the toplevel *) - -val add_module_rules - : Super_context.t - -> dir:Path.t - -> (unit, Lib.t list) Build.t - -> unit -(** Add rules to generate a utop module that will all have all the include dirs - for the dependencies *) - -val utop_exe_dir : dir:Path.t -> Path.t -(** Return the directory in which the main module for the top level will be - generated. *) - val utop_exe : Path.t -> Path.t (** Return the path of the utop bytecode binary inside a directory where some libraries are defined. *) + +val setup + : Super_context.t + -> dir:Path.t + -> libs:Jbuild.Library.t list + -> scope:Scope.t + -> unit