Replace meta language by ocaml
This commit is contained in:
parent
8d52cba130
commit
38421d7e41
57
doc/jbuild
57
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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
|
@ -1,5 +0,0 @@
|
|||
(** Meta Jbuild language *)
|
||||
|
||||
open! Import
|
||||
|
||||
val expand : Sexp.Ast.t list -> context:Context.t -> Sexp.Ast.t list
|
|
@ -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
31
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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
(jbuild_version 1)
|
||||
|
||||
(library
|
||||
((name jbuilder_re)
|
||||
(public_name jbuilder.re)
|
||||
(preprocess no_preprocessing)))
|
||||
(public_name jbuilder.re)))
|
||||
|
|
Loading…
Reference in New Issue