This commit is contained in:
Calascibetta Romain 2025-01-03 11:54:13 +01:00
parent bee9f14226
commit ff1fdc9c2b
5 changed files with 38 additions and 33 deletions

View file

@ -2,5 +2,5 @@
(name vif)
(public_name vif)
(flags
(:standard -w -18))
(:standard -w -18 -linkall))
(libraries logs.fmt fmt.tty vif.top))

View file

@ -21,8 +21,9 @@ let main =
{ocaml|let v = 42;;|ocaml}
; {ocaml|let rec infinity () = infinity ();;|ocaml}
; {ocaml|print_endline "Hello World!";;|ocaml}
; {ocaml|let a = Bool.to_int true;;|ocaml}
; {ocaml|#show_dirs;;|ocaml}
; {ocaml|let a = Bool.to_int true;;|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|let fn () = print_endline "Hello from Miou!";;|ocaml}
; {ocaml|Miou.run fn;;|ocaml}

View file

@ -7,6 +7,7 @@
vif.meta
compiler-libs
compiler-libs.common
compiler-libs.toplevel
compiler-libs.native-toplevel))
(ocamllex vif_meta_lexer)

View file

@ -2,10 +2,7 @@ let src = Logs.Src.create "vif.top"
module Log = (val Logs.src_log src : Logs.LOG)
type cfg = {
stdlib: Fpath.t
; roots: Fpath.t list
}
type cfg = { stdlib: Fpath.t; roots: Fpath.t list }
let errors = ref false
@ -120,51 +117,61 @@ module Phrase = struct
| _ -> false
end
let load cfg str =
let load cfg str =
let ( let* ) = Result.bind in
Log.debug (fun m -> m "load: %s" str);
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 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 [] | None -> path in
| Some [] | None -> path
in
match List.assoc_opt "plugin" descr with
| 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.rev artifacts in
Log.debug (fun m -> m "load: @[<hov>%a@]"
Fmt.(Dump.list Fpath.pp) artifacts);
Log.debug (fun m -> m "load: @[<hov>%a@]" Fmt.(Dump.list Fpath.pp) artifacts);
Ok artifacts
let load cfg str =
match load cfg str with
| Ok artifacts ->
let fn artifact =
let dir = Fpath.parent artifact in
Topdirs.dir_directory (Fpath.(to_string dir));
Topdirs.dir_load Fmt.stderr (Fpath.to_string artifact)
in
List.iter fn artifacts
| Error (`Msg msg) ->
Log.err (fun m -> m "Impossible to load %S: %s" str msg)
let fn artifact =
let dir = Fpath.parent artifact in
Topdirs.dir_directory Fpath.(to_string dir);
Topdirs.dir_load Fmt.stderr (Fpath.to_string artifact)
in
List.iter fn artifacts
| Error (`Msg msg) -> Log.err (fun m -> m "Impossible to load %S: %s" str msg)
let init cfg =
let ppf = Fmt.stderr in
Sys.interactive := false;
Clflags.native_code := true;
Clflags.debug := true;
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 ();
Toploop.toplevel_env := Compmisc.initial_env ();
Toploop.initialize_toplevel_env ();
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;
Compmisc.init_path ();
Sys.interactive := false;
(* Topdirs.dir_directory (Fpath.(to_string cfg.stdlib)); *)
(* Toploop.loop Format.std_formatter *)
Topcommon.run_hooks Topcommon.After_setup;
Toploop.add_directive "require"
(Toploop.Directive_string (load cfg))
{ Toploop.section= "Vif loader"
; doc= "Load a package" }
{ Toploop.section= "Vif loader"; doc= "Load a package" }
let config ~stdlib roots =
let cfg = { stdlib; roots } in

View file

@ -1,8 +1,4 @@
type cfg
val config :
stdlib:Fpath.t
-> Fpath.t list
-> cfg
val config : stdlib:Fpath.t -> Fpath.t list -> cfg
val eval : cfg -> string list -> (string list, string list) result