matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Replace meta language by ocaml

This commit is contained in:
Jérémie Dimino 2017-02-26 19:49:54 +00:00
parent 8d52cba130
commit 38421d7e41
24 changed files with 263 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
doc/jbuild
View File

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

14
doc/manual.org
View File

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

1
jbuild
View File

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

17
plugin/jbuild_plugin.mli Normal file
View File

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

2
src/context.ml
View File

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

3
src/context.mli
View File

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

35
src/gen_rules.ml
View File

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

2
src/gen_rules.mli
View File

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

10
src/import.ml
View File

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

7
src/jbuild
View File

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

158
src/jbuild_load.ml
View File

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

6
src/jbuild_load.mli
View File

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

191
src/jbuild_meta_lang.ml
View File

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

5
src/jbuild_meta_lang.mli
View File

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

25
src/jbuild_types.ml
View File

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

31
src/main.ml
View File

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

2
src/main.mli
View File

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

6
src/sexp_lexer.mli
View File

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

13
src/sexp_lexer.mll
View File

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

3
src/sexp_load.ml
View File

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

1
src/sexp_load.mli
View File

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

11
src/workspace.ml
View File

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

5
vendor/cmdliner/src/jbuild vendored
View File

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

5
vendor/re/src/jbuild vendored
View File

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