diff --git a/doc/jbuild b/doc/jbuild index e0e7f120..0a5d5c3f 100644 --- a/doc/jbuild +++ b/doc/jbuild @@ -1,40 +1,47 @@ -(use_meta_lang) +(* -*- tuareg -*- *) + +open StdLabels + +let commands = + [ "build" + ; "build-package" + ; "external-lib-deps" + ; "install" + ; "installed-libraries" + ; "runtest" + ; "uninstall" + ] + +let jbuild = + String.concat ~sep:"" + ({| +(jbuild_version 1) (install ((section doc) (files (manual.org)))) -(:let :commands - (build - build-package - external-lib-deps - install - installed-libraries - runtest - uninstall)) - -(:let-macro (:man-file :cmd) - (:concat "" (jbuilder- (:cmd) .1))) - (rule ((targets (jbuilder.1)) (action (with-stdout-to ${@} (run ${bin:jbuilder} --help=groff))))) - -(:foreach :cmd (:commands) - (rule - ((targets ((:man-file (:cmd)))) - (action (with-stdout-to ${@} - (run ${bin:jbuilder} (:cmd) --help=groff)))))) - +|} :: List.map commands ~f:(fun cmd -> + Printf.sprintf {| +(rule + ((targets (jbuilder-%s.1)) + (action (with-stdout-to ${@} + (run ${bin:jbuilder} %s --help=groff))))) +|} cmd cmd) + @ [ Printf.sprintf {| (install ((section man) (files ( jbuilder.1 - (:foreach :cmd (:commands) (:man-file (:cmd))) + %s )))) +|} (String.concat ~sep:"\n " + (List.map commands ~f:(Printf.sprintf "jbuilder-%s.1"))) + ]) -(alias - ((name runtest) - (deps (jbuild)) - (action (run ${bin:cinaps} ${<})))) +let () = + Jbuild_plugin.V1.send jbuild diff --git a/doc/manual.org b/doc/manual.org index 6faa377d..021b24c2 100644 --- a/doc/manual.org +++ b/doc/manual.org @@ -108,11 +108,8 @@ publication of Jane Street packages easier. Except for the special =jane_street= version, there is currently only one version available, but to be future proof, you should still -specify it in your toplevel =jbuild= file. If no version is specified, -the latest one will be used. Specifying a version in a =jbuild= file -will affect the current file as well as the sub-tree where it is -defined. As a result it is recommended to specify the version in the -toplevel jbuild file of your project. +specify it in your =jbuild= files. If no version is specified, the +latest one will be used. ** Metadata format @@ -208,11 +205,10 @@ everything Jbuilder needs to know about. The following sections describe the available stanzas and their meaning. -**** jbuilder_version +**** jbuid_verrsion -=(jbuilder_version 1)= specifies that we are using the version 1 of -the Jbuilder metadata format in this =jbuild= file and the sub-tree -starting from this directory. +=(jbuild_version 1)= specifies that we are using the version 1 of the +Jbuilder metadata format in this =jbuild= file. **** library diff --git a/jbuild b/jbuild deleted file mode 100644 index 0947b360..00000000 --- a/jbuild +++ /dev/null @@ -1 +0,0 @@ -(jbuilder_version 1) diff --git a/plugin/jbuild_plugin.mli b/plugin/jbuild_plugin.mli new file mode 100644 index 00000000..bff68d72 --- /dev/null +++ b/plugin/jbuild_plugin.mli @@ -0,0 +1,17 @@ +(** API for jbuild plugins *) + +module V1 : sig + (** Current build context *) + val context : string + + (** OCaml version for the current buid context. It might not be the + same as [Sys.ocaml_version] *) + val ocaml_version : string + + (** Output of [ocamlc -config] for this context *) + val ocamlc_config : (string * string) list + + (** [send s] send [s] to jbuilder. [s] should be the contents of a + jbuild file following the specification described in the manual. *) + val send : string -> unit +end diff --git a/src/context.ml b/src/context.ml index d2ab23ee..9e4a59fe 100644 --- a/src/context.ml +++ b/src/context.ml @@ -23,6 +23,7 @@ type t = ; findlib_path : Path.t list ; arch_sixtyfour : bool ; opam_var_cache : (string, string) Hashtbl.t + ; ocamlc_config : (string * string) list ; version : string ; stdlib_dir : Path.t ; ccomp_type : string @@ -187,6 +188,7 @@ let create ~(kind : Kind.t) ~path ~env ~name = ; opam_var_cache ; stdlib_dir + ; ocamlc_config = String_map.bindings ocamlc_config ; version = get "version" ; ccomp_type = get "ccomp_type" ; bytecomp_c_compiler = get "bytecomp_c_compiler" diff --git a/src/context.mli b/src/context.mli index 5b1850d6..96d3b349 100644 --- a/src/context.mli +++ b/src/context.mli @@ -60,7 +60,8 @@ type t = ; opam_var_cache : (string, string) Hashtbl.t ; (** Output of [ocamlc -config] *) - version : string + ocamlc_config : (string * string) list + ; version : string ; stdlib_dir : Path.t ; ccomp_type : string ; bytecomp_c_compiler : string diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 3de3e3ce..4ad02f7c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1779,23 +1779,24 @@ module Gen(P : Params) = struct end let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf = + let open Future in let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in let alias_store = Alias.Store.create () in - let rules = - List.concat_map contexts ~f:(fun context -> - let stanzas = List.map jbuilds ~f:(Jbuild_load.Jbuild.eval ~context) in - let module M = - Gen(struct - let context = context - let file_tree = file_tree - let stanzas = stanzas - let packages = packages - let filter_out_optional_stanzas_with_missing_deps = - filter_out_optional_stanzas_with_missing_deps - let alias_store = alias_store - end) - in - !M.all_rules) - in + List.map contexts ~f:(fun context -> + Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas -> + let module M = + Gen(struct + let context = context + let file_tree = file_tree + let stanzas = stanzas + let packages = packages + let filter_out_optional_stanzas_with_missing_deps = + filter_out_optional_stanzas_with_missing_deps + let alias_store = alias_store + end) + in + !M.all_rules) + |> Future.all + >>| fun rules -> Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree - @ rules + @ List.concat rules diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 55b4d7fa..45bbdec8 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -4,4 +4,4 @@ val gen : contexts:Context.t list -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *) -> Jbuild_load.conf - -> Build_interpret.Rule.t list + -> Build_interpret.Rule.t list Future.t diff --git a/src/import.ml b/src/import.ml index 74f6d542..473dd2ca 100644 --- a/src/import.ml +++ b/src/import.ml @@ -90,6 +90,14 @@ module Hashtbl = struct match find t key with | exception Not_found -> None | x -> Some x + + let find_or_add t key ~f = + match find t key with + | Some x -> x + | None -> + let x = f () in + add t ~key ~data:x; + x end module Map = struct @@ -314,6 +322,8 @@ let read_file fn = let lines_of_file fn = with_file_in fn ~f:input_lines +let write_file fn data = with_file_out fn ~f:(fun oc -> output_string oc data) + exception Fatal_error of string let die fmt = ksprintf (fun msg -> raise (Fatal_error msg)) fmt diff --git a/src/jbuild b/src/jbuild index 7c5fe57d..47c1fa25 100644 --- a/src/jbuild +++ b/src/jbuild @@ -1,9 +1,8 @@ -;; This program must have no dependencies outside of the compiler -;; distribution as it is used to build all of Jane Street packages +(jbuild_version 1) + (library ((name jbuilder) (public_name jbuilder) - (libraries (unix jbuilder_re)) - (preprocess no_preprocessing))) + (libraries (unix jbuilder_re)))) (ocamllex (sexp_lexer meta_lexer rewrite_generated_file glob_lexer)) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 91f7a2ed..0401205f 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -1,68 +1,110 @@ open Import open Jbuild_types -module Jbuild = struct - type t = - | Constant of Path.t * Stanza.t list - | With_macros of - { path : Path.t - ; version : Jbuilder_version.t - ; sexps : Sexp.Ast.t list +module Jbuilds = struct + type one = + | Literal of Path.t * Stanza.t list + | Script of + { dir : Path.t ; visible_packages : Package.t String_map.t } - let eval jbuild ~context = - match jbuild with - | Constant (path, stanzas) -> (path, stanzas) - | With_macros { path - ; version - ; sexps - ; visible_packages - } -> - let sexps = Jbuild_meta_lang.expand ~context sexps in - (path, Stanzas.parse sexps ~dir:path ~visible_packages ~version) + type t = one list + + let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds" + let contexts_files_dir = Path.(relative root) "_build/.contexts" + + let ensure_parent_dir_exists path = + match Path.kind path with + | Local path -> Path.Local.ensure_parent_directory_exists path + | External _ -> () + + let create_context_file (context : Context.t) = + let file = Path.relative contexts_files_dir (context.name ^ ".ml") in + ensure_parent_dir_exists file; + with_file_out (Path.to_string file) ~f:(fun oc -> + Printf.fprintf oc {| +module Jbuild_plugin = struct + module V1 = struct + let context = %S + let ocaml_version = %S + + let ocamlc_config = + [ %s + ] + + let send s = + let oc = open_out_bin Sys.argv.(1) in + output_string oc s; + close_out oc + end +end +|} + context.name + context.version + (String.concat ~sep:"\n ; " + (let longest = List.longest_map context.ocamlc_config ~f:fst in + List.map context.ocamlc_config ~f:(fun (k, v) -> + Printf.sprintf "%-*S , %S" (longest + 2) k v)))); + file + + let eval jbuilds ~(context : Context.t) = + let open Future in + let context_files = Hashtbl.create 8 in + List.map jbuilds ~f:(function + | Literal (path, stanzas) -> + return (path, stanzas) + | Script { dir + ; visible_packages + } -> + let file = Path.relative dir "jbuild" in + let generated_jbuild = + Path.append (Path.relative generated_jbuilds_dir context.name) file + in + let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in + ensure_parent_dir_exists generated_jbuild; + let context_file, context_file_contents = + Hashtbl.find_or_add context_files context.name ~f:(fun () -> + let file = create_context_file context in + (file, read_file (Path.to_string file))) + in + Printf.ksprintf (write_file (Path.to_string wrapper)) + "# 1 %S\n\ + %s\n\ + # 1 %S\n\ + %s" + (Path.to_string context_file) + context_file_contents + (Path.to_string file) + (read_file (Path.to_string file)); + run ~dir:(Path.to_string dir) ~env:context.env + (Path.to_string context.Context.ocaml) + [ Path.reach ~from:dir wrapper + ; Path.reach ~from:dir generated_jbuild + ] + >>= fun () -> + let sexps = Sexp_load.many (Path.to_string generated_jbuild) in + return (dir, Stanzas.parse sexps ~dir ~visible_packages)) + |> Future.all end type conf = { file_tree : File_tree.t ; tree : Alias.tree - ; jbuilds : Jbuild.t list + ; jbuilds : Jbuilds.t ; packages : Package.t String_map.t } -let load ~dir ~visible_packages ~version = - let sexps = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) in - let versions, sexps = - List.partition_map sexps ~f:(function - | List (loc, [Atom (_, "jbuilder_version"); ver]) -> - Inl (Jbuilder_version.t ver, loc) - | sexp -> Inr sexp) - in - let version = - match versions with - | [] -> version - | [(v, _)] -> v - | _ :: (_, loc) :: _ -> - Loc.fail loc "jbuilder_version specified too many times" - in - let use_meta_lang, sexps = - List.partition_map sexps ~f:(function - | List (_, [Atom (_, "use_meta_lang")]) -> Inl () - | sexp -> Inr sexp) - in - let jbuild = - match use_meta_lang with - | [] -> - Jbuild.Constant (dir, Stanzas.parse sexps ~dir ~visible_packages ~version) - | _ -> - With_macros - { path = dir - ; version - ; sexps - ; visible_packages - } - in - (version, jbuild) +let load ~dir ~visible_packages = + let file = Path.relative dir "jbuild" in + match Sexp_load.many_or_ocaml_script (Path.to_string file) with + | Sexps sexps -> + Jbuilds.Literal (dir, Stanzas.parse sexps ~dir ~visible_packages) + | Ocaml_script -> + Script + { dir + ; visible_packages + } let load () = let ftree = File_tree.load Path.root in @@ -102,7 +144,7 @@ let load () = |> List.map ~f:(fun pkg -> (pkg.Package.path, pkg)) |> Path.Map.of_alist_multi in - let rec walk dir jbuilds visible_packages version = + let rec walk dir jbuilds visible_packages = let path = File_tree.Dir.path dir in let files = File_tree.Dir.files dir in let sub_dirs = File_tree.Dir.sub_dirs dir in @@ -113,12 +155,12 @@ let load () = List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg -> String_map.add acc ~key:pkg.Package.name ~data:pkg) in - let version, jbuilds = + let jbuilds = if String_set.mem "jbuild" files then - let version, jbuild = load ~dir:path ~visible_packages ~version in - (version, jbuild :: jbuilds) + let jbuild = load ~dir:path ~visible_packages in + jbuild :: jbuilds else - (version, jbuilds) + jbuilds in let sub_dirs = if String_set.mem "jbuild-ignore" files then @@ -134,13 +176,13 @@ let load () = let children, jbuilds = String_map.fold sub_dirs ~init:([], jbuilds) ~f:(fun ~key:_ ~data:dir (children, jbuilds) -> - let child, jbuilds = walk dir jbuilds visible_packages version in + let child, jbuilds = walk dir jbuilds visible_packages in (child :: children, jbuilds)) in (Alias.Node (path, children), jbuilds) in let root = File_tree.root ftree in - let tree, jbuilds = walk root [] String_map.empty Jbuilder_version.latest_stable in + let tree, jbuilds = walk root [] String_map.empty in { file_tree = ftree ; tree ; jbuilds diff --git a/src/jbuild_load.mli b/src/jbuild_load.mli index 22356049..80633e7b 100644 --- a/src/jbuild_load.mli +++ b/src/jbuild_load.mli @@ -1,15 +1,15 @@ open Import -module Jbuild : sig +module Jbuilds : sig type t - val eval : t -> context:Context.t -> Path.t * Jbuild_types.Stanzas.t + val eval : t -> context:Context.t -> (Path.t * Jbuild_types.Stanzas.t) list Future.t end type conf = { file_tree : File_tree.t ; tree : Alias.tree - ; jbuilds : Jbuild.t list + ; jbuilds : Jbuilds.t ; packages : Package.t String_map.t } diff --git a/src/jbuild_meta_lang.ml b/src/jbuild_meta_lang.ml deleted file mode 100644 index 0dcb98a4..00000000 --- a/src/jbuild_meta_lang.ml +++ /dev/null @@ -1,191 +0,0 @@ -open Import -open Sexp.Of_sexp - -module To = Sexp.To_sexp - -module Prim = struct - module Spec = struct - [@@@warning "-37"] - - type ('a, 'b) t = - | Ret : ('b -> Sexp.t) -> ('b, 'b) t - | Rest : (Sexp.Ast.t -> 'a) * ('b -> Sexp.t) -> ('a list -> 'b, 'b) t - | Abs : (Sexp.Ast.t -> 'a) * ('b, 'c) t -> ('a -> 'b, 'c) t - - let ( @> ) a b = Abs (a, b) - - let rec apply - : type a b. (a, b) t -> loc:Loc.t -> Sexp.Ast.t list -> a -> Sexp.Ast.t - = fun t ~loc l f -> - match t, l with - | Ret conv, [] -> Sexp.add_loc (conv f) ~loc - | Ret _, _ :: _ -> Loc.fail loc "too many arguments" - | Rest (conv, ret_conv), l -> - Sexp.add_loc (ret_conv (f (List.map l ~f:conv))) ~loc - | Abs _, [] -> Loc.fail loc "not enough arguments" - | Abs (conv, t), x :: l -> - apply t ~loc l (f (conv x)) - end - - type ('a, 'b) unpacked = - { spec : ('a, 'b) Spec.t - ; exec : 'a - } - - type t = T : (_, _) unpacked -> t - - let make spec exec = T { spec; exec } - - let exec (T { spec; exec }) ~loc args = - Spec.apply spec ~loc args exec -end - -type env = - { context : Context.t - ; macros : macro String_map.t - } - -and macro = - | Value of Sexp.Ast.t list - | Closure of - { env : env - ; pattern : Sexp.Ast.t - ; form : Sexp.Ast.t list - } - | Prim of Prim.t - -let prims = - let open Prim.Spec in - let mk name spec exec = (name, Prim (Prim.make spec exec)) in - let cmp name f = mk name (string @> string @> Ret To.bool) f in - (* CR-someday jdimino: implement proper version comparison *) - [ cmp ":ver<" (<) - ; cmp ":ver<=" (<=) - ; cmp ":ver=" (=) - ; cmp ":ver>=" (>=) - ; cmp ":ver>" (>) - ; mk ":concat" (string @> list string @> Ret To.string) - (fun sep l -> String.concat ~sep l) - ] |> String_map.of_alist_exn - -let make_env context = - { context; macros = prims } - -let bind env var macro = - { env with macros = String_map.add env.macros ~key:var ~data:macro } - -let rec match_pattern env ~pattern ~value = - match pattern, value with - | Atom (_, var), _ when String.is_prefix var ~prefix:":" -> - bind env var (Value [value]) - | Atom (_, a), Atom (_, b) when a = b -> env - | List (_, a), List (_, b) when List.length a = List.length b -> - List.fold_left2 a b ~init:env ~f:(fun env pattern value -> - match_pattern env ~pattern ~value) - | _ -> - Loc.fail (Sexp.Ast.loc pattern) - "Failed to match value against pattern:\n\ - - pattern: %s\n\ - - value: %s" - (Sexp.Ast.to_string pattern) - (Sexp.Ast.to_string value) - -let unexpected sexp values ~expected = - Loc.fail (Sexp.Ast.loc sexp) - "%s expected here, got:\n\ - \ %s" - expected - (String.concat ~sep:", " - (List.map values ~f:Sexp.Ast.to_string)) - -let rec eval env t = - match t with - | Atom _ -> (env, [t]) - | List (_, Atom (_, ":quote") :: args) -> (env, args) - | List (loc, Atom (_, ":if") :: args) -> begin - let cond, then_, else_ = - match args with - | [cond; then_] -> - let loc = Sexp.Ast.loc then_ in - (cond, then_, List ({ loc with start = loc.stop }, [])) - | [cond; then_; else_] -> - (cond, then_, else_) - | _ -> - Loc.fail loc "invalid (:if ...) form" - in - match eval_bool env cond with - | true -> eval env else_ - | false -> eval env then_ - end - | List (loc, Atom (_, ":foreach") :: args) -> begin - match args with - | pattern :: vals :: form -> begin - let vals = eval_list env vals in - (env, - List.concat_map vals ~f:(fun value -> - let env = match_pattern env ~pattern ~value in - eval_seq env form)) - end - | _ -> - Loc.fail loc "invalid (:foreach ...) form" - end - | List (loc, Atom (_, ":let") :: args) -> begin - match args with - | [pattern; value] -> - let value = eval_one env value in - (match_pattern env ~pattern ~value, []) - | _ -> - Loc.fail loc "invalid (:let ...) form" - end - | List (loc, Atom (_, ":let-macro") :: args) -> begin - match args with - | List (_, Atom (_, s) :: _) as pattern :: form when s <> "" && s.[0] = ':' -> - (bind env s (Closure { env; pattern; form }), - []) - | _ -> - Loc.fail loc "invalid (:let-macro ...) form" - end - | List (loc, (Atom (loc_s, s) :: args)) when s <> "" && s.[0] = ':' -> begin - match String_map.find s env.macros with - | None -> Loc.fail loc_s "Unknown macro %S" s - | Some (Value x) -> (env, x) - | Some (Closure { env = closure_env; pattern; form }) -> - let args = eval_seq env args in - let t = List (loc, Atom (loc_s, s) :: args) in - (env, - let env = match_pattern closure_env ~pattern ~value:t in - eval_seq env form) - | Some (Prim prim) -> - let args = eval_seq env args in - (env, - [Prim.exec prim args ~loc]) - end - | List (loc, l) -> - (env, [List (loc, eval_seq env l)]) - -and eval_seq env l = - match l with - | [] -> [] - | sexp :: rest -> - let env, res = eval env sexp in - res @ eval_seq env rest - -and eval_one env sexp = - match snd (eval env sexp) with - | [sexp] -> sexp - | l -> unexpected sexp l ~expected:"single value" - -and eval_list env sexp = - match eval_one env sexp with - | List (_, l) -> l - | l -> unexpected sexp [l] ~expected:"list" - -and eval_bool env sexp : bool = - match eval_one env sexp with - | Atom (_, "true" ) -> true - | Atom (_, "false") -> false - | l -> unexpected sexp [l] ~expected:"true or false" - -let expand sexps ~context = - let env = make_env context in - eval_seq env sexps diff --git a/src/jbuild_meta_lang.mli b/src/jbuild_meta_lang.mli deleted file mode 100644 index 831a4d60..00000000 --- a/src/jbuild_meta_lang.mli +++ /dev/null @@ -1,5 +0,0 @@ -(** Meta Jbuild language *) - -open! Import - -val expand : Sexp.Ast.t list -> context:Context.t -> Sexp.Ast.t list diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index eb24c72a..9f9866f7 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -8,7 +8,7 @@ open Sexp.Of_sexp [jane_street] version. When they are all the same, sexp parsers are just named [t]. *) -module Jbuilder_version = struct +module Jbuild_version = struct type t = | V1 | Vjs @@ -788,8 +788,8 @@ module Stanza = struct ; cstr' "install" [Install_conf.v1] (fun x -> Install x) ; cstr' "alias" [Alias_conf.v1] (fun x -> Alias x) (* Just for validation and error messages *) - ; cstr "jbuilder_version" [Jbuilder_version.t] (fun _ -> None) - ; cstr "use_meta_lang" [] None + ; cstr "jbuild_version" [Jbuild_version.t] (fun _ -> None) + ; cstr "use_meta_lang" [] None ] let vjs = @@ -808,10 +808,10 @@ module Stanza = struct ; ign "unified_tests" ; ign "embed" (* Just for validation and error messages *) - ; cstr "jbuilder_version" [Jbuilder_version.t] (fun _ -> None) + ; cstr "jbuild_version" [Jbuild_version.t] (fun _ -> None) ] - let select : Jbuilder_version.t -> t option Sexp.Of_sexp.t = function + let select : Jbuild_version.t -> t option Sexp.Of_sexp.t = function | V1 -> v1 | Vjs -> vjs @@ -874,7 +874,20 @@ module Stanzas = struct Install { install with package = Some (default ()) } | _ -> stanza) - let parse sexps ~dir ~visible_packages ~version = + let parse sexps ~dir ~visible_packages = + let versions, sexps = + List.partition_map sexps ~f:(function + | List (loc, [Atom (_, "jbuilder_version"); ver]) -> + Inl (Jbuild_version.t ver, loc) + | sexp -> Inr sexp) + in + let version = + match versions with + | [] -> Jbuild_version.latest_stable + | [(v, _)] -> v + | _ :: (_, loc) :: _ -> + Loc.fail loc "jbuilder_version specified too many times" + in List.filter_map sexps ~f:(Stanza.select version) |> resolve_packages ~dir ~visible_packages end diff --git a/src/main.ml b/src/main.ml index 64d3a54d..cb6eacb0 100644 --- a/src/main.ml +++ b/src/main.ml @@ -3,7 +3,7 @@ open Future type setup = { build_system : Build_system.t - ; jbuilds : Jbuild_load.Jbuild.t list + ; jbuilds : Jbuild_load.Jbuilds.t ; contexts : Context.t list ; packages : Package.t String_map.t } @@ -30,10 +30,9 @@ let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () = | Opam { name; switch; root } -> Context.create_for_opam ~name ~switch ?root ())) >>= fun contexts -> - let rules = - Gen_rules.gen conf ~contexts - ?filter_out_optional_stanzas_with_missing_deps - in + Gen_rules.gen conf ~contexts + ?filter_out_optional_stanzas_with_missing_deps + >>= fun rules -> let build_system = Build_system.create ~file_tree:conf.file_tree ~rules in return { build_system ; jbuilds = conf.jbuilds @@ -44,25 +43,25 @@ let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () = let external_lib_deps ?log ~packages () = Future.Scheduler.go ?log (setup () ~filter_out_optional_stanzas_with_missing_deps:false - >>| fun ({ build_system = bs; jbuilds; contexts; _ } as setup) -> + >>= fun ({ build_system = bs; jbuilds; contexts; _ } as setup) -> let install_files = List.map packages ~f:(fun pkg -> match package_install_file setup pkg with | Ok path -> path | Error () -> die "Unknown package %S" pkg) in + let context = + match List.find contexts ~f:(fun c -> c.name = "default") with + | None -> die "You need to set a default context to use external-lib-deps" + | Some context -> context + in + Jbuild_load.Jbuilds.eval ~context jbuilds + >>| fun stanzas -> + let internals = Jbuild_types.Stanza.lib_names stanzas in Path.Map.map (Build_system.all_lib_deps bs install_files) - ~f:(fun deps -> - let context = - match List.find contexts ~f:(fun c -> c.name = "default") with - | None -> die "You need to set a default context to use external-lib-deps" - | Some context -> context - in - let stanzas = List.map jbuilds ~f:(Jbuild_load.Jbuild.eval ~context) in - let internals = Jbuild_types.Stanza.lib_names stanzas in - String_map.filter deps ~f:(fun name _ -> - not (String_set.mem name internals)))) + ~f:(String_map.filter ~f:(fun name _ -> + not (String_set.mem name internals)))) let report_error ?(map_fname=fun x->x) ppf exn ~backtrace = match exn with diff --git a/src/main.mli b/src/main.mli index 3642ce35..c70fb830 100644 --- a/src/main.mli +++ b/src/main.mli @@ -2,7 +2,7 @@ open! Import type setup = { build_system : Build_system.t - ; jbuilds : Jbuild_load.Jbuild.t list + ; jbuilds : Jbuild_load.Jbuilds.t ; contexts : Context.t list ; packages : Package.t String_map.t } diff --git a/src/sexp_lexer.mli b/src/sexp_lexer.mli index 6319a93a..293adc4e 100644 --- a/src/sexp_lexer.mli +++ b/src/sexp_lexer.mli @@ -1,2 +1,8 @@ val single : Lexing.lexbuf -> Sexp.Ast.t val many : Lexing.lexbuf -> Sexp.Ast.t list + +type sexps_or_ocaml_script = + | Sexps of Sexp.Ast.t list + | Ocaml_script + +val many_or_ocaml_script : Lexing.lexbuf -> sexps_or_ocaml_script diff --git a/src/sexp_lexer.mll b/src/sexp_lexer.mll index 82b2d4d2..d9273da8 100644 --- a/src/sexp_lexer.mll +++ b/src/sexp_lexer.mll @@ -1,4 +1,8 @@ { +type sexps_or_ocaml_script = + | Sexps of Sexp.Ast.t list + | Ocaml_script + type stack = | Empty | Open of Lexing.position * stack @@ -176,6 +180,10 @@ and trailing = parse | _ { error lexbuf "garbage after s-expression" } +and is_ocaml_script = parse + | "(* -*- tuareg -*- *)" { true } + | "" { false } + { let single lexbuf = match main Empty lexbuf with @@ -189,4 +197,9 @@ and trailing = parse | Some sexp -> loop (sexp :: acc) in loop [] + + let many_or_ocaml_script lexbuf = + match is_ocaml_script lexbuf with + | true -> Ocaml_script + | false -> Sexps (many lexbuf) } diff --git a/src/sexp_load.ml b/src/sexp_load.ml index 50dc93e7..1925e2d8 100644 --- a/src/sexp_load.ml +++ b/src/sexp_load.ml @@ -5,3 +5,6 @@ let single fn = let many fn = with_lexbuf_from_file fn ~f:Sexp_lexer.many + +let many_or_ocaml_script fn = + with_lexbuf_from_file fn ~f:Sexp_lexer.many_or_ocaml_script diff --git a/src/sexp_load.mli b/src/sexp_load.mli index c688f2b3..707a8135 100644 --- a/src/sexp_load.mli +++ b/src/sexp_load.mli @@ -2,3 +2,4 @@ open! Import val single : string -> Sexp.Ast.t val many : string -> Sexp.Ast.t list +val many_or_ocaml_script : string -> Sexp_lexer.sexps_or_ocaml_script diff --git a/src/workspace.ml b/src/workspace.ml index a59196f9..5703fb19 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -41,11 +41,12 @@ let t sexps = sexp in let name = Context.name ctx in - begin match name with - | ".aliases" | "log" -> - of_sexp_errorf sexp "%S is not allowed as a build context name" name - | _ -> () - end; + if name = "" || + String.is_prefix name ~prefix:"." || + name = "log" || + String.contains name '/' || + String.contains name '\\' then + of_sexp_errorf sexp "%S is not allowed as a build context name" name; if List.exists acc ~f:(fun c -> Context.name c = name) then of_sexp_errorf sexp "second definition of build context %S" name; ctx :: acc) diff --git a/vendor/cmdliner/src/jbuild b/vendor/cmdliner/src/jbuild index ab3d9c80..4c24a5d3 100644 --- a/vendor/cmdliner/src/jbuild +++ b/vendor/cmdliner/src/jbuild @@ -1,5 +1,6 @@ +(jbuild_version 1) + (library ((name jbuilder_cmdliner) (public_name jbuilder.cmdliner) - (flags (-w -3-6-27-32-33-35-50)) - (preprocess no_preprocessing))) + (flags (-w -3-6-27-32-33-35-50)))) diff --git a/vendor/re/src/jbuild b/vendor/re/src/jbuild index a8e06b6d..932bdace 100644 --- a/vendor/re/src/jbuild +++ b/vendor/re/src/jbuild @@ -1,4 +1,5 @@ +(jbuild_version 1) + (library ((name jbuilder_re) - (public_name jbuilder.re) - (preprocess no_preprocessing))) + (public_name jbuilder.re)))