Refactor utop module to use the new exe module
This commit is contained in:
parent
6bde0c21b3
commit
80ed205e38
|
@ -870,13 +870,11 @@ module Gen(P : Params) = struct
|
||||||
Path.Set.add (Path.relative src_dir ".") m.source_dirs
|
Path.Set.add (Path.relative src_dir ".") m.source_dirs
|
||||||
})
|
})
|
||||||
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
|
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
|
||||||
Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
|
Utop.setup sctx ~dir:ctx_dir ~libs:(
|
||||||
let dir = Utop.utop_exe_dir ~dir:ctx_dir in
|
List.filter_map stanzas ~f:(function
|
||||||
let merlin =
|
| Stanza.Library lib -> Some lib
|
||||||
executables_rules exe ~dir ~all_modules ~scope
|
| _ -> None)
|
||||||
in
|
) ~scope;
|
||||||
Utop.add_module_rules sctx ~dir merlin.requires;
|
|
||||||
);
|
|
||||||
Modules_partitioner.emit_warnings modules_partitioner
|
Modules_partitioner.emit_warnings modules_partitioner
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
|
|
93
src/utop.ml
93
src/utop.ml
|
@ -4,8 +4,8 @@ open Build.O
|
||||||
open! No_io
|
open! No_io
|
||||||
|
|
||||||
let exe_name = "utop"
|
let exe_name = "utop"
|
||||||
let module_name = String.capitalize_ascii exe_name
|
let main_module_name = String.capitalize_ascii exe_name
|
||||||
let module_filename = exe_name ^ ".ml"
|
let main_module_filename = exe_name ^ ".ml"
|
||||||
|
|
||||||
let pp_ml fmt include_dirs =
|
let pp_ml fmt include_dirs =
|
||||||
let pp_include fmt =
|
let pp_include fmt =
|
||||||
|
@ -19,7 +19,7 @@ let pp_ml fmt include_dirs =
|
||||||
Format.fprintf fmt "@.UTop_main.main ();@."
|
Format.fprintf fmt "@.UTop_main.main ();@."
|
||||||
|
|
||||||
let add_module_rules sctx ~dir lib_requires =
|
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 =
|
let utop_ml =
|
||||||
lib_requires
|
lib_requires
|
||||||
>>^ (fun libs ->
|
>>^ (fun libs ->
|
||||||
|
@ -36,59 +36,6 @@ let add_module_rules sctx ~dir lib_requires =
|
||||||
>>> Build.write_file_dyn path in
|
>>> Build.write_file_dyn path in
|
||||||
Super_context.add_rule sctx utop_ml
|
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 ~dir = Path.relative dir ".utop"
|
||||||
|
|
||||||
let utop_exe dir =
|
let utop_exe dir =
|
||||||
|
@ -98,3 +45,37 @@ let utop_exe dir =
|
||||||
custom mode. We do that so that it works without hassle when
|
custom mode. We do that so that it works without hassle when
|
||||||
generating a utop for a library with C stubs. *)
|
generating a utop for a library with C stubs. *)
|
||||||
|> Path.extend_basename ~suffix:(Mode.exe_ext Mode.Native)
|
|> 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
|
||||||
|
|
28
src/utop.mli
28
src/utop.mli
|
@ -1,26 +1,12 @@
|
||||||
(** Utop rules *)
|
(** 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
|
val utop_exe : Path.t -> Path.t
|
||||||
(** Return the path of the utop bytecode binary inside a directory where
|
(** Return the path of the utop bytecode binary inside a directory where
|
||||||
some libraries are defined. *)
|
some libraries are defined. *)
|
||||||
|
|
||||||
|
val setup
|
||||||
|
: Super_context.t
|
||||||
|
-> dir:Path.t
|
||||||
|
-> libs:Jbuild.Library.t list
|
||||||
|
-> scope:Scope.t
|
||||||
|
-> unit
|
||||||
|
|
Loading…
Reference in New Issue