.
This commit is contained in:
parent
bee9f14226
commit
ff1fdc9c2b
5 changed files with 38 additions and 33 deletions
2
bin/dune
2
bin/dune
|
@ -2,5 +2,5 @@
|
||||||
(name vif)
|
(name vif)
|
||||||
(public_name vif)
|
(public_name vif)
|
||||||
(flags
|
(flags
|
||||||
(:standard -w -18))
|
(:standard -w -18 -linkall))
|
||||||
(libraries logs.fmt fmt.tty vif.top))
|
(libraries logs.fmt fmt.tty vif.top))
|
||||||
|
|
|
@ -21,8 +21,9 @@ let main =
|
||||||
{ocaml|let v = 42;;|ocaml}
|
{ocaml|let v = 42;;|ocaml}
|
||||||
; {ocaml|let rec infinity () = infinity ();;|ocaml}
|
; {ocaml|let rec infinity () = infinity ();;|ocaml}
|
||||||
; {ocaml|print_endline "Hello World!";;|ocaml}
|
; {ocaml|print_endline "Hello World!";;|ocaml}
|
||||||
; {ocaml|let a = Bool.to_int true;;|ocaml}
|
; {ocaml|let a = Bool.to_int true;;|ocaml}; {ocaml|#show_dirs;;|ocaml}
|
||||||
; {ocaml|#show_dirs;;|ocaml}
|
; {ocaml|#directory "/home/dinosaure/.opam/5.2.0+ocamlnat/lib/ocaml/";;|ocaml}
|
||||||
|
; {ocaml|#load "/home/dinosaure/.opam/5.2.0+ocamlnat/lib/ocaml/stdlib.cmxa";;|ocaml}
|
||||||
; {ocaml|#require "miou";;|ocaml}
|
; {ocaml|#require "miou";;|ocaml}
|
||||||
; {ocaml|let fn () = print_endline "Hello from Miou!";;|ocaml}
|
; {ocaml|let fn () = print_endline "Hello from Miou!";;|ocaml}
|
||||||
; {ocaml|Miou.run fn;;|ocaml}
|
; {ocaml|Miou.run fn;;|ocaml}
|
||||||
|
|
1
lib/dune
1
lib/dune
|
@ -7,6 +7,7 @@
|
||||||
vif.meta
|
vif.meta
|
||||||
compiler-libs
|
compiler-libs
|
||||||
compiler-libs.common
|
compiler-libs.common
|
||||||
|
compiler-libs.toplevel
|
||||||
compiler-libs.native-toplevel))
|
compiler-libs.native-toplevel))
|
||||||
|
|
||||||
(ocamllex vif_meta_lexer)
|
(ocamllex vif_meta_lexer)
|
||||||
|
|
|
@ -2,10 +2,7 @@ let src = Logs.Src.create "vif.top"
|
||||||
|
|
||||||
module Log = (val Logs.src_log src : Logs.LOG)
|
module Log = (val Logs.src_log src : Logs.LOG)
|
||||||
|
|
||||||
type cfg = {
|
type cfg = { stdlib: Fpath.t; roots: Fpath.t list }
|
||||||
stdlib: Fpath.t
|
|
||||||
; roots: Fpath.t list
|
|
||||||
}
|
|
||||||
|
|
||||||
let errors = ref false
|
let errors = ref false
|
||||||
|
|
||||||
|
@ -124,18 +121,22 @@ let load cfg str =
|
||||||
let ( let* ) = Result.bind in
|
let ( let* ) = Result.bind in
|
||||||
Log.debug (fun m -> m "load: %s" str);
|
Log.debug (fun m -> m "load: %s" str);
|
||||||
let* path = Vif_meta.Path.of_string str in
|
let* path = Vif_meta.Path.of_string str in
|
||||||
let* deps = Vif_meta.ancestors ~roots:cfg.roots ~predicates:[ "native" ] path in
|
let* deps =
|
||||||
|
Vif_meta.ancestors ~roots:cfg.roots ~predicates:[ "native" ] path
|
||||||
|
in
|
||||||
let fn acc (_, path, descr) =
|
let fn acc (_, path, descr) =
|
||||||
let path = match List.assoc_opt "directory" descr with
|
let path =
|
||||||
|
match List.assoc_opt "directory" descr with
|
||||||
| Some (dir :: _) -> Fpath.(to_dir_path (path / dir))
|
| Some (dir :: _) -> Fpath.(to_dir_path (path / dir))
|
||||||
| Some [] | None -> path in
|
| Some [] | None -> path
|
||||||
|
in
|
||||||
match List.assoc_opt "plugin" descr with
|
match List.assoc_opt "plugin" descr with
|
||||||
| Some (plugin :: _) -> Fpath.(path / plugin) :: acc
|
| Some (plugin :: _) -> Fpath.(path / plugin) :: acc
|
||||||
| Some [] | None -> acc in
|
| Some [] | None -> acc
|
||||||
|
in
|
||||||
let artifacts = List.fold_left fn [] deps in
|
let artifacts = List.fold_left fn [] deps in
|
||||||
let artifacts = List.rev artifacts in
|
let artifacts = List.rev artifacts in
|
||||||
Log.debug (fun m -> m "load: @[<hov>%a@]"
|
Log.debug (fun m -> m "load: @[<hov>%a@]" Fmt.(Dump.list Fpath.pp) artifacts);
|
||||||
Fmt.(Dump.list Fpath.pp) artifacts);
|
|
||||||
Ok artifacts
|
Ok artifacts
|
||||||
|
|
||||||
let load cfg str =
|
let load cfg str =
|
||||||
|
@ -143,28 +144,34 @@ let load cfg str =
|
||||||
| Ok artifacts ->
|
| Ok artifacts ->
|
||||||
let fn artifact =
|
let fn artifact =
|
||||||
let dir = Fpath.parent artifact in
|
let dir = Fpath.parent artifact in
|
||||||
Topdirs.dir_directory (Fpath.(to_string dir));
|
Topdirs.dir_directory Fpath.(to_string dir);
|
||||||
Topdirs.dir_load Fmt.stderr (Fpath.to_string artifact)
|
Topdirs.dir_load Fmt.stderr (Fpath.to_string artifact)
|
||||||
in
|
in
|
||||||
List.iter fn artifacts
|
List.iter fn artifacts
|
||||||
| Error (`Msg msg) ->
|
| Error (`Msg msg) -> Log.err (fun m -> m "Impossible to load %S: %s" str msg)
|
||||||
Log.err (fun m -> m "Impossible to load %S: %s" str msg)
|
|
||||||
|
|
||||||
let init cfg =
|
let init cfg =
|
||||||
|
let ppf = Fmt.stderr in
|
||||||
|
Sys.interactive := false;
|
||||||
Clflags.native_code := true;
|
Clflags.native_code := true;
|
||||||
|
Clflags.debug := true;
|
||||||
Topcommon.update_search_path_from_env ();
|
Topcommon.update_search_path_from_env ();
|
||||||
|
Compenv.readenv ppf Compenv.Before_args;
|
||||||
|
(* Clflags.add_arguments __LOC__ Option.list; *)
|
||||||
|
(* Compenv.parse_arguments ~current argv file_argument program; *)
|
||||||
|
(* Compmisc.read_clflags_from_env (); *)
|
||||||
|
(* - Toploop.prepare ppf () *)
|
||||||
Topcommon.set_paths ();
|
Topcommon.set_paths ();
|
||||||
Toploop.toplevel_env := Compmisc.initial_env ();
|
Toploop.initialize_toplevel_env ();
|
||||||
let objs = !Compenv.first_objfiles in
|
let objs = !Compenv.first_objfiles in
|
||||||
List.iter (Topdirs.dir_load Fmt.stderr) objs;
|
List.iter (Topdirs.dir_load ppf) objs;
|
||||||
Topcommon.run_hooks Topcommon.Startup;
|
Topcommon.run_hooks Topcommon.Startup;
|
||||||
Compmisc.init_path ();
|
Compmisc.init_path ();
|
||||||
Sys.interactive := false;
|
(* Toploop.loop Format.std_formatter *)
|
||||||
(* Topdirs.dir_directory (Fpath.(to_string cfg.stdlib)); *)
|
Topcommon.run_hooks Topcommon.After_setup;
|
||||||
Toploop.add_directive "require"
|
Toploop.add_directive "require"
|
||||||
(Toploop.Directive_string (load cfg))
|
(Toploop.Directive_string (load cfg))
|
||||||
{ Toploop.section= "Vif loader"
|
{ Toploop.section= "Vif loader"; doc= "Load a package" }
|
||||||
; doc= "Load a package" }
|
|
||||||
|
|
||||||
let config ~stdlib roots =
|
let config ~stdlib roots =
|
||||||
let cfg = { stdlib; roots } in
|
let cfg = { stdlib; roots } in
|
||||||
|
|
|
@ -1,8 +1,4 @@
|
||||||
type cfg
|
type cfg
|
||||||
|
|
||||||
val config :
|
val config : stdlib:Fpath.t -> Fpath.t list -> cfg
|
||||||
stdlib:Fpath.t
|
|
||||||
-> Fpath.t list
|
|
||||||
-> cfg
|
|
||||||
|
|
||||||
val eval : cfg -> string list -> (string list, string list) result
|
val eval : cfg -> string list -> (string list, string list) result
|
||||||
|
|
Loading…
Reference in a new issue