Replace meta language by ocaml

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)))))
-
+|} :: List.map commands ~f:(fun cmd ->
-(:foreach :cmd (:commands)
+        Printf.sprintf {|
- (rule
+(rule
-  ((targets ((:man-file (:cmd))))
+ ((targets (jbuilder-%s.1))
-   (action  (with-stdout-to ${@}
+  (action  (with-stdout-to ${@}
-                            (run ${bin:jbuilder} (:cmd) --help=groff))))))
+            (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
+let () =
- ((name runtest)
+  Jbuild_plugin.V1.send jbuild
-  (deps (jbuild))
-  (action (run ${bin:cinaps} ${<}))))

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,
+specify it in your =jbuild= files. If no version is specified, the
-the latest one will be used. Specifying a version in a =jbuild= file
+latest one will be used.
-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.
 
 ** 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
+=(jbuild_version 1)= specifies that we are using the version 1 of the
-the Jbuilder metadata format in this =jbuild= file and the sub-tree
+Jbuilder metadata format in this =jbuild= file.
-starting from this directory.
 
 **** library
 

jbuild

@@ -1 +0,0 @@
-(jbuilder_version 1)

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

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"

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

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.map contexts ~f:(fun context ->
-    List.concat_map contexts ~f:(fun context ->
+    Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas ->
-      let stanzas = List.map jbuilds ~f:(Jbuild_load.Jbuild.eval ~context) in
+    let module M =
-      let module M =
+      Gen(struct
-        Gen(struct
+        let context  = context
-          let context  = context
+        let file_tree = file_tree
-          let file_tree = file_tree
+        let stanzas  = stanzas
-          let stanzas  = stanzas
+        let packages = packages
-          let packages = packages
+        let filter_out_optional_stanzas_with_missing_deps =
-          let filter_out_optional_stanzas_with_missing_deps =
+          filter_out_optional_stanzas_with_missing_deps
-            filter_out_optional_stanzas_with_missing_deps
+        let alias_store = alias_store
-          let alias_store = alias_store
+      end)
-        end)
+    in
-      in
+    !M.all_rules)
-      !M.all_rules)
+  |> Future.all
-  in
+  >>| fun rules ->
   Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
-  @ rules
+  @ List.concat rules

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

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
 

src/jbuild

@@ -1,9 +1,8 @@
-;; This program must have no dependencies outside of the compiler
+(jbuild_version 1)
-;; distribution as it is used to build all of Jane Street packages
+
 (library
  ((name        jbuilder)
   (public_name jbuilder)
-  (libraries   (unix jbuilder_re))
+  (libraries   (unix jbuilder_re))))
-  (preprocess  no_preprocessing)))
 
 (ocamllex (sexp_lexer meta_lexer rewrite_generated_file glob_lexer))

src/jbuild_load.ml

@@ -1,68 +1,110 @@
 open Import
 open Jbuild_types
 
-module Jbuild = struct
+module Jbuilds = struct
-  type t =
+  type one =
-    | Constant of Path.t * Stanza.t list
+    | Literal of Path.t * Stanza.t list
-    | With_macros of
+    | Script of
-        { path             : Path.t
+        { dir              : Path.t
-        ; version          : Jbuilder_version.t
-        ; sexps            : Sexp.Ast.t list
         ; visible_packages : Package.t String_map.t
         }
 
-  let eval jbuild ~context =
+  type t = one list
-    match jbuild with
+
-    | Constant (path, stanzas) -> (path, stanzas)
+  let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds"
-    | With_macros { path
+  let contexts_files_dir = Path.(relative root) "_build/.contexts"
-                  ; version
+
-                  ; sexps
+  let ensure_parent_dir_exists path =
-                  ; visible_packages
+    match Path.kind path with
-                  } ->
+    | Local path -> Path.Local.ensure_parent_directory_exists path
-      let sexps = Jbuild_meta_lang.expand ~context sexps in
+    | External _ -> ()
-      (path, Stanzas.parse sexps ~dir:path ~visible_packages ~version)
+
+  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 load ~dir ~visible_packages =
-  let sexps = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) in
+  let file = Path.relative dir "jbuild" in
-  let versions, sexps =
+  match Sexp_load.many_or_ocaml_script (Path.to_string file) with
-    List.partition_map sexps ~f:(function
+  | Sexps sexps ->
-      | List (loc, [Atom (_, "jbuilder_version"); ver]) ->
+    Jbuilds.Literal (dir, Stanzas.parse sexps ~dir ~visible_packages)
-        Inl (Jbuilder_version.t ver, loc)
+  | Ocaml_script ->
-      | sexp -> Inr sexp)
+    Script
-  in
+      { dir
-  let version =
+      ; visible_packages
-    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 () =
   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
+        let jbuild = load ~dir:path ~visible_packages in
-        (version, jbuild :: jbuilds)
+        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

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
   }
 

src/jbuild_meta_lang.ml

@@ -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

src/jbuild_meta_lang.mli

@@ -1,5 +0,0 @@
-(** Meta Jbuild language *)
-
-open! Import
-
-val expand : Sexp.Ast.t list -> context:Context.t -> Sexp.Ast.t list

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 "jbuild_version" [Jbuild_version.t] (fun _ -> None)
-      ; cstr "use_meta_lang"    []                   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

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
-    Gen_rules.gen conf ~contexts
+    ?filter_out_optional_stanzas_with_missing_deps
-      ?filter_out_optional_stanzas_with_missing_deps
+  >>= fun rules ->
-  in
   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 ->
+       ~f:(String_map.filter ~f:(fun name _ ->
-           let context =
+           not (String_set.mem name internals))))
-             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))))
 
 let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
   match exn with

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
   }

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

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)
 }

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

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

src/workspace.ml

@@ -41,11 +41,12 @@ let t sexps =
         sexp
     in
     let name = Context.name ctx in
-    begin match name with
+    if name = "" ||
-    | ".aliases" | "log" ->
+       String.is_prefix name ~prefix:"." ||
-      of_sexp_errorf sexp "%S is not allowed as a build context name" name
+       name = "log" ||
-    | _ -> ()
+       String.contains name '/' ||
-    end;
+       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)

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))
+  (flags (-w -3-6-27-32-33-35-50))))
-  (preprocess  no_preprocessing)))

vendor/re/src/jbuild

@@ -1,4 +1,5 @@
+(jbuild_version 1)
+
 (library
  ((name        jbuilder_re)
-  (public_name jbuilder.re)
+  (public_name jbuilder.re)))
-  (preprocess  no_preprocessing)))