1043 lines
32 KiB
OCaml
1043 lines
32 KiB
OCaml
open Import
|
|
open Sexp.Of_sexp
|
|
|
|
(* This file defines the jbuild types as well as the S-expression syntax for the various
|
|
supported version of the specification.
|
|
|
|
[vN] is for the version [N] of the specification and [vjs] is for the rolling
|
|
[jane_street] version, when needed.
|
|
*)
|
|
|
|
module Jbuild_version = struct
|
|
type t =
|
|
| V1
|
|
|
|
let t =
|
|
enum
|
|
[ "1", V1
|
|
]
|
|
|
|
let latest_stable = V1
|
|
end
|
|
|
|
let invalid_module_name name sexp =
|
|
of_sexp_error sexp (sprintf "invalid module name: %S" name)
|
|
|
|
let module_name sexp =
|
|
let name = string sexp in
|
|
match name with
|
|
| "" -> invalid_module_name name sexp
|
|
| s ->
|
|
(match s.[0] with
|
|
| 'A'..'Z' | 'a'..'z' -> ()
|
|
| _ -> invalid_module_name name sexp);
|
|
String.iter s ~f:(function
|
|
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '\'' | '_' -> ()
|
|
| _ -> invalid_module_name name sexp);
|
|
String.capitalize_ascii s
|
|
|
|
let module_names sexp = String_set.of_list (list module_name sexp)
|
|
|
|
let invalid_lib_name sexp =
|
|
of_sexp_error sexp "invalid library name"
|
|
|
|
let library_name sexp =
|
|
match string sexp with
|
|
| "" -> invalid_lib_name sexp
|
|
| s ->
|
|
if s.[0] = '.' then invalid_lib_name sexp;
|
|
String.iter s ~f:(function
|
|
| 'A'..'Z' | 'a'..'z' | '_' | '.' | '0'..'9' -> ()
|
|
| _ -> invalid_lib_name sexp);
|
|
s
|
|
|
|
let file sexp =
|
|
match string sexp with
|
|
| "." | ".." ->
|
|
of_sexp_error sexp "'.' and '..' are not valid filenames"
|
|
| fn -> fn
|
|
|
|
let file_in_current_dir sexp =
|
|
match string sexp with
|
|
| "." | ".." ->
|
|
of_sexp_error sexp "'.' and '..' are not valid filenames"
|
|
| fn ->
|
|
if Filename.dirname fn <> Filename.current_dir_name then
|
|
of_sexp_error sexp "file in current directory expected";
|
|
fn
|
|
|
|
let relative_file sexp =
|
|
let fn = file sexp in
|
|
if not (Filename.is_relative fn) then
|
|
of_sexp_error sexp "relative filename expected";
|
|
fn
|
|
|
|
module Scope = struct
|
|
type t =
|
|
{ name : string option
|
|
; packages : Package.t String_map.t
|
|
; root : Path.t
|
|
}
|
|
|
|
let empty =
|
|
{ name = None
|
|
; packages = String_map.empty
|
|
; root = Path.root
|
|
}
|
|
|
|
let make = function
|
|
| [] -> empty
|
|
| pkg :: rest as pkgs ->
|
|
let name =
|
|
List.fold_left rest ~init:pkg.Package.name ~f:(fun acc pkg ->
|
|
min acc pkg.Package.name)
|
|
in
|
|
let root = pkg.path in
|
|
List.iter rest ~f:(fun pkg -> assert (pkg.Package.path = root));
|
|
{ name = Some name
|
|
; packages =
|
|
String_map.of_alist_exn (List.map pkgs ~f:(fun pkg ->
|
|
pkg.Package.name, pkg))
|
|
; root
|
|
}
|
|
|
|
let package_listing packages =
|
|
let longest_pkg = List.longest_map packages ~f:(fun p -> p.Package.name) in
|
|
String.concat ~sep:"\n"
|
|
(List.map packages ~f:(fun pkg ->
|
|
sprintf "- %-*s (because of %s)" longest_pkg pkg.Package.name
|
|
(Path.to_string (Path.relative pkg.path (pkg.name ^ ".opam")))))
|
|
|
|
let default t =
|
|
match String_map.values t.packages with
|
|
| [pkg] -> Ok pkg
|
|
| [] ->
|
|
Error
|
|
"The current scope defines no packages.\n\
|
|
What do you want me to do with this (install ...) stanzas?.\n\
|
|
You need to add a <package>.opam file at the root \
|
|
of your project so that\n\
|
|
I know that you want to install things as part of package <package>."
|
|
| _ :: _ :: _ ->
|
|
Error
|
|
(sprintf
|
|
"I can't determine automatically which package this (install ...) \
|
|
stanza is for. I have the choice between these ones:\n\
|
|
%s\n\
|
|
You need to add a (package ...) field in this (install ...) stanza"
|
|
(package_listing (String_map.values t.packages)))
|
|
|
|
let resolve t name =
|
|
match String_map.find name t.packages with
|
|
| Some pkg ->
|
|
Ok pkg
|
|
| None ->
|
|
if String_map.is_empty t.packages then
|
|
Error (sprintf
|
|
"You cannot declare items to be installed without \
|
|
adding a <package>.opam file at the root of your project.\n\
|
|
To declare elements to be installed as part of package %S, \
|
|
add a %S file at the root of your project."
|
|
name (name ^ ".opam"))
|
|
else
|
|
Error (sprintf
|
|
"The current scope doesn't define package %S.\n\
|
|
The only packages for which you can declare \
|
|
elements to be installed in this directory are:\n\
|
|
%s%s"
|
|
name
|
|
(package_listing (String_map.values t.packages))
|
|
(hint name (String_map.keys t.packages)))
|
|
|
|
let package t sexp =
|
|
match resolve t (string sexp) with
|
|
| Ok p -> p
|
|
| Error s -> Loc.fail (Sexp.Ast.loc sexp) "%s" s
|
|
|
|
let package_field t =
|
|
map_validate (field_o "package" string) ~f:(function
|
|
| None -> default t
|
|
| Some name -> resolve t name)
|
|
end
|
|
|
|
|
|
module Pp : sig
|
|
type t
|
|
val of_string : string -> t
|
|
val to_string : t -> string
|
|
val compare : t -> t -> int
|
|
end = struct
|
|
type t = string
|
|
|
|
let of_string s =
|
|
assert (not (String.is_prefix s ~prefix:"-"));
|
|
s
|
|
|
|
let to_string t = t
|
|
|
|
let compare = String.compare
|
|
end
|
|
|
|
module Pp_or_flags = struct
|
|
type t =
|
|
| PP of Pp.t
|
|
| Flags of string list
|
|
|
|
let of_string s =
|
|
if String.is_prefix s ~prefix:"-" then
|
|
Flags [s]
|
|
else
|
|
PP (Pp.of_string s)
|
|
|
|
let t = function
|
|
| Atom (_, s) -> of_string s
|
|
| List (_, l) -> Flags (List.map l ~f:string)
|
|
|
|
let split l =
|
|
let pps, flags =
|
|
List.partition_map l ~f:(function
|
|
| PP pp -> Inl pp
|
|
| Flags s -> Inr s)
|
|
in
|
|
(pps, List.concat flags)
|
|
end
|
|
|
|
module Dep_conf = struct
|
|
type t =
|
|
| File of String_with_vars.t
|
|
| Alias of String_with_vars.t
|
|
| Alias_rec of String_with_vars.t
|
|
| Glob_files of String_with_vars.t
|
|
| Files_recursively_in of String_with_vars.t
|
|
|
|
let t =
|
|
let t =
|
|
let cstr name f =
|
|
cstr name (String_with_vars.t @> nil) f
|
|
in
|
|
sum
|
|
[ cstr "file" (fun x -> File x)
|
|
; cstr "alias" (fun x -> Alias x)
|
|
; cstr "alias_rec" (fun x -> Alias_rec x)
|
|
; cstr "glob_files" (fun x -> Glob_files x)
|
|
; cstr "files_recursively_in" (fun x -> Files_recursively_in x)
|
|
]
|
|
in
|
|
fun sexp ->
|
|
match sexp with
|
|
| Atom _ -> File (String_with_vars.t sexp)
|
|
| List _ -> t sexp
|
|
|
|
open Sexp
|
|
let sexp_of_t = function
|
|
| File t ->
|
|
List [Atom "file" ; String_with_vars.sexp_of_t t]
|
|
| Alias t ->
|
|
List [Atom "alias" ; String_with_vars.sexp_of_t t]
|
|
| Alias_rec t ->
|
|
List [Atom "alias_rec" ; String_with_vars.sexp_of_t t]
|
|
| Glob_files t ->
|
|
List [Atom "glob_files" ; String_with_vars.sexp_of_t t]
|
|
| Files_recursively_in t ->
|
|
List [Atom "files_recursively_in" ; String_with_vars.sexp_of_t t]
|
|
end
|
|
|
|
module Preprocess = struct
|
|
type pps = { pps : Pp.t list; flags : string list }
|
|
type t =
|
|
| No_preprocessing
|
|
| Action of Action.Unexpanded.t
|
|
| Pps of pps
|
|
|
|
let t =
|
|
sum
|
|
[ cstr "no_preprocessing" nil No_preprocessing
|
|
; cstr "action" (Action.Unexpanded.t @> nil) (fun x -> Action x)
|
|
; cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
|
|
let pps, flags = Pp_or_flags.split l in
|
|
Pps { pps; flags })
|
|
]
|
|
|
|
let pps = function
|
|
| Pps { pps; _ } -> pps
|
|
| _ -> []
|
|
end
|
|
|
|
module Per_module = struct
|
|
type 'a t =
|
|
| For_all of 'a
|
|
| Per_module of 'a String_map.t
|
|
|
|
let t a sexp =
|
|
match sexp with
|
|
| List (_, Atom (_, "per_module") :: rest) -> begin
|
|
List.concat_map rest ~f:(fun sexp ->
|
|
let pp, names = pair a module_names sexp in
|
|
List.map (String_set.elements names) ~f:(fun name -> (name, pp)))
|
|
|> String_map.of_alist
|
|
|> function
|
|
| Ok map -> Per_module map
|
|
| Error (name, _, _) ->
|
|
of_sexp_error sexp (sprintf "module %s present in two different sets" name)
|
|
end
|
|
| sexp -> For_all (a sexp)
|
|
end
|
|
|
|
module Preprocess_map = struct
|
|
type t = Preprocess.t Per_module.t
|
|
let t = Per_module.t Preprocess.t
|
|
|
|
let no_preprocessing = Per_module.For_all Preprocess.No_preprocessing
|
|
|
|
let find module_name (t : t) =
|
|
match t with
|
|
| For_all pp -> pp
|
|
| Per_module map -> String_map.find_default module_name map ~default:No_preprocessing
|
|
|
|
let default : t = For_all No_preprocessing
|
|
|
|
module Pp_set = Set.Make(Pp)
|
|
|
|
let pps : t -> _ = function
|
|
| For_all pp -> Preprocess.pps pp
|
|
| Per_module map ->
|
|
String_map.fold map ~init:Pp_set.empty ~f:(fun ~key:_ ~data:pp acc ->
|
|
Pp_set.union acc (Pp_set.of_list (Preprocess.pps pp)))
|
|
|> Pp_set.elements
|
|
end
|
|
|
|
module Lint = struct
|
|
type t = Preprocess_map.t
|
|
|
|
let t = Preprocess_map.t
|
|
|
|
let default = Preprocess_map.default
|
|
let no_lint = default
|
|
end
|
|
|
|
let field_oslu name =
|
|
field name Ordered_set_lang.Unexpanded.t ~default:Ordered_set_lang.Unexpanded.standard
|
|
|
|
module Js_of_ocaml = struct
|
|
|
|
type t =
|
|
{ flags : Ordered_set_lang.Unexpanded.t
|
|
; javascript_files : string list
|
|
}
|
|
|
|
let t =
|
|
record
|
|
(field_oslu "flags" >>= fun flags ->
|
|
field "javascript_files" (list string) ~default:[] >>= fun javascript_files ->
|
|
return { flags; javascript_files })
|
|
|
|
let default =
|
|
{ flags = Ordered_set_lang.Unexpanded.standard
|
|
; javascript_files = [] }
|
|
end
|
|
|
|
module Lib_dep = struct
|
|
type choice =
|
|
{ required : String_set.t
|
|
; forbidden : String_set.t
|
|
; file : string
|
|
}
|
|
|
|
type select =
|
|
{ result_fn : string
|
|
; choices : choice list
|
|
; loc : Loc.t (* For error messages *)
|
|
}
|
|
|
|
type t =
|
|
| Direct of string
|
|
| Select of select
|
|
|
|
let choice = function
|
|
| List (_, l) as sexp ->
|
|
let rec loop required forbidden = function
|
|
| [Atom (_, "->"); fsexp] ->
|
|
let common = String_set.inter required forbidden in
|
|
if not (String_set.is_empty common) then
|
|
of_sexp_errorf sexp
|
|
"library %S is both required and forbidden in this clause"
|
|
(String_set.choose common);
|
|
{ required
|
|
; forbidden
|
|
; file = file fsexp
|
|
}
|
|
| Atom (_, "->") :: _ | List _ :: _ | [] ->
|
|
of_sexp_error sexp "(<[!]libraries>... -> <file>) expected"
|
|
| Atom (_, s) :: l ->
|
|
let len = String.length s in
|
|
if len > 0 && s.[0] = '!' then
|
|
let s = String.sub s ~pos:1 ~len:(len - 1) in
|
|
loop required (String_set.add s forbidden) l
|
|
else
|
|
loop (String_set.add s required) forbidden l
|
|
in
|
|
loop String_set.empty String_set.empty l
|
|
| sexp -> of_sexp_error sexp "(<library-name> <code>) expected"
|
|
|
|
let t = function
|
|
| Atom (_, s) ->
|
|
Direct s
|
|
| List (loc, Atom (_, "select") :: m :: Atom (_, "from") :: libs) ->
|
|
Select { result_fn = file m
|
|
; choices = List.map libs ~f:choice
|
|
; loc
|
|
}
|
|
| sexp ->
|
|
of_sexp_error sexp "<library> or (select <module> from <libraries...>) expected"
|
|
|
|
let to_lib_names = function
|
|
| Direct s -> [s]
|
|
| Select s ->
|
|
List.fold_left s.choices ~init:String_set.empty ~f:(fun acc x ->
|
|
String_set.union acc (String_set.union x.required x.forbidden))
|
|
|> String_set.elements
|
|
|
|
let direct s = Direct s
|
|
end
|
|
|
|
module Lib_deps = struct
|
|
type t = Lib_dep.t list
|
|
|
|
type kind =
|
|
| Required
|
|
| Optional
|
|
| Forbidden
|
|
|
|
let t sexp =
|
|
let t = list Lib_dep.t sexp in
|
|
let add kind name acc =
|
|
match String_map.find name acc with
|
|
| None -> String_map.add acc ~key:name ~data:kind
|
|
| Some kind' ->
|
|
match kind, kind' with
|
|
| Required, Required ->
|
|
of_sexp_errorf sexp "library %S is present twice" name
|
|
| (Optional|Forbidden), (Optional|Forbidden) ->
|
|
acc
|
|
| Optional, Required | Required, Optional ->
|
|
of_sexp_errorf sexp
|
|
"library %S is present both as an optional and required dependency"
|
|
name
|
|
| Forbidden, Required | Required, Forbidden ->
|
|
of_sexp_errorf sexp
|
|
"library %S is present both as a forbidden and required dependency"
|
|
name
|
|
in
|
|
ignore (
|
|
List.fold_left t ~init:String_map.empty ~f:(fun acc x ->
|
|
match x with
|
|
| Lib_dep.Direct s -> add Required s acc
|
|
| Select { choices; _ } ->
|
|
List.fold_left choices ~init:acc ~f:(fun acc c ->
|
|
let acc = String_set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) in
|
|
String_set.fold c.forbidden ~init:acc ~f:(add Forbidden)))
|
|
: kind String_map.t);
|
|
t
|
|
end
|
|
|
|
module Buildable = struct
|
|
type t =
|
|
{ modules : Ordered_set_lang.t
|
|
; libraries : Lib_dep.t list
|
|
; preprocess : Preprocess_map.t
|
|
; preprocessor_deps : Dep_conf.t list
|
|
; lint : Preprocess_map.t
|
|
; flags : Ordered_set_lang.Unexpanded.t
|
|
; ocamlc_flags : Ordered_set_lang.Unexpanded.t
|
|
; ocamlopt_flags : Ordered_set_lang.Unexpanded.t
|
|
; js_of_ocaml : Js_of_ocaml.t
|
|
; gen_dot_merlin : bool
|
|
}
|
|
|
|
let v1 =
|
|
field "preprocess" Preprocess_map.t ~default:Preprocess_map.default
|
|
>>= fun preprocess ->
|
|
field "preprocessor_deps" (list Dep_conf.t) ~default:[]
|
|
>>= fun preprocessor_deps ->
|
|
(* CR-someday jdimino: remove this. There are still a few Jane Street packages using
|
|
this *)
|
|
field "lint" Lint.t ~default:Lint.default
|
|
>>= fun lint ->
|
|
field "modules" (fun s -> Ordered_set_lang.(map (t s)) ~f:String.capitalize_ascii)
|
|
~default:Ordered_set_lang.standard
|
|
>>= fun modules ->
|
|
field "libraries" Lib_deps.t ~default:[]
|
|
>>= fun libraries ->
|
|
field_oslu "flags" >>= fun flags ->
|
|
field_oslu "ocamlc_flags" >>= fun ocamlc_flags ->
|
|
field_oslu "ocamlopt_flags" >>= fun ocamlopt_flags ->
|
|
field "js_of_ocaml" (Js_of_ocaml.t) ~default:Js_of_ocaml.default >>= fun js_of_ocaml ->
|
|
return
|
|
{ preprocess
|
|
; preprocessor_deps
|
|
; lint
|
|
; modules
|
|
; libraries
|
|
; flags
|
|
; ocamlc_flags
|
|
; ocamlopt_flags
|
|
; js_of_ocaml
|
|
; gen_dot_merlin = true
|
|
}
|
|
|
|
let single_preprocess t =
|
|
match t.preprocess with
|
|
| For_all pp -> pp
|
|
| Per_module _ -> No_preprocessing
|
|
end
|
|
|
|
module Public_lib = struct
|
|
type t =
|
|
{ name : string
|
|
; package : Package.t
|
|
; sub_dir : string option
|
|
}
|
|
|
|
let public_name_field pkgs =
|
|
map_validate (field_o "public_name" string) ~f:(function
|
|
| None -> Ok None
|
|
| Some s ->
|
|
match String.split s ~on:'.' with
|
|
| [] -> assert false
|
|
| pkg :: rest ->
|
|
match Scope.resolve pkgs pkg with
|
|
| Ok pkg ->
|
|
Ok (Some
|
|
{ package = pkg
|
|
; sub_dir = if rest = [] then None else Some (String.concat rest ~sep:"/")
|
|
; name = s
|
|
})
|
|
| Error _ as e -> e)
|
|
end
|
|
|
|
module Library = struct
|
|
module Kind = struct
|
|
type t =
|
|
| Normal
|
|
| Ppx_deriver
|
|
| Ppx_rewriter
|
|
|
|
let t =
|
|
enum
|
|
[ "normal" , Normal
|
|
; "ppx_deriver" , Ppx_deriver
|
|
; "ppx_rewriter" , Ppx_rewriter
|
|
]
|
|
end
|
|
|
|
type t =
|
|
{ name : string
|
|
; public : Public_lib.t option
|
|
; synopsis : string option
|
|
; install_c_headers : string list
|
|
; ppx_runtime_libraries : string list
|
|
; modes : Mode.Dict.Set.t
|
|
; kind : Kind.t
|
|
; c_flags : Ordered_set_lang.Unexpanded.t
|
|
; c_names : string list
|
|
; cxx_flags : Ordered_set_lang.Unexpanded.t
|
|
; cxx_names : string list
|
|
; library_flags : Ordered_set_lang.Unexpanded.t
|
|
; c_library_flags : Ordered_set_lang.Unexpanded.t
|
|
; self_build_stubs_archive : string option
|
|
; virtual_deps : string list
|
|
; wrapped : bool
|
|
; optional : bool
|
|
; buildable : Buildable.t
|
|
; dynlink : bool
|
|
}
|
|
|
|
let v1 pkgs =
|
|
record
|
|
(Buildable.v1 >>= fun buildable ->
|
|
field "name" library_name >>= fun name ->
|
|
Public_lib.public_name_field pkgs >>= fun public ->
|
|
field_o "synopsis" string >>= fun synopsis ->
|
|
field "install_c_headers" (list string) ~default:[] >>= fun install_c_headers ->
|
|
field "ppx_runtime_libraries" (list string) ~default:[] >>= fun ppx_runtime_libraries ->
|
|
field_oslu "c_flags" >>= fun c_flags ->
|
|
field_oslu "cxx_flags" >>= fun cxx_flags ->
|
|
field "c_names" (list string) ~default:[] >>= fun c_names ->
|
|
field "cxx_names" (list string) ~default:[] >>= fun cxx_names ->
|
|
field_oslu "library_flags" >>= fun library_flags ->
|
|
field_oslu "c_library_flags" >>= fun c_library_flags ->
|
|
field "virtual_deps" (list string) ~default:[] >>= fun virtual_deps ->
|
|
field "modes" Mode.Dict.Set.t ~default:Mode.Dict.Set.all >>= fun modes ->
|
|
field "kind" Kind.t ~default:Kind.Normal >>= fun kind ->
|
|
field "wrapped" bool ~default:true >>= fun wrapped ->
|
|
field_b "optional" >>= fun optional ->
|
|
field "self_build_stubs_archive" (option string) ~default:None >>= fun self_build_stubs_archive ->
|
|
field_b "no_dynlink" >>= fun no_dynlink ->
|
|
return
|
|
{ name
|
|
; public
|
|
; synopsis
|
|
; install_c_headers
|
|
; ppx_runtime_libraries
|
|
; modes
|
|
; kind
|
|
; c_names
|
|
; c_flags
|
|
; cxx_names
|
|
; cxx_flags
|
|
; library_flags
|
|
; c_library_flags
|
|
; self_build_stubs_archive
|
|
; virtual_deps
|
|
; wrapped
|
|
; optional
|
|
; buildable
|
|
; dynlink = not no_dynlink
|
|
})
|
|
|
|
let has_stubs t =
|
|
match t.c_names, t.cxx_names, t.self_build_stubs_archive with
|
|
| [], [], None -> false
|
|
| _ -> true
|
|
|
|
let stubs_archive t ~dir ~ext_lib =
|
|
Path.relative dir (sprintf "lib%s_stubs%s" t.name ext_lib)
|
|
|
|
let all_lib_deps t =
|
|
List.map t.virtual_deps ~f:(fun s -> Lib_dep.Direct s) @ t.buildable.libraries
|
|
|
|
let best_name t =
|
|
match t.public with
|
|
| None -> t.name
|
|
| Some p -> p.name
|
|
end
|
|
|
|
module Install_conf = struct
|
|
type file =
|
|
{ src : string
|
|
; dst : string option
|
|
}
|
|
|
|
let file sexp =
|
|
match sexp with
|
|
| Atom (_, src) -> { src; dst = None }
|
|
| List (_, [Atom (_, src); Atom (_, "as"); Atom (_, dst)]) ->
|
|
{ src; dst = Some dst }
|
|
| _ ->
|
|
of_sexp_error sexp
|
|
"invalid format, <name> or (<name> as <install-as>) expected"
|
|
|
|
type t =
|
|
{ section : Install.Section.t
|
|
; files : file list
|
|
; package : Package.t
|
|
}
|
|
|
|
let v1 pkgs =
|
|
record
|
|
(field "section" Install.Section.t >>= fun section ->
|
|
field "files" (list file) >>= fun files ->
|
|
Scope.package_field pkgs >>= fun package ->
|
|
return
|
|
{ section
|
|
; files
|
|
; package
|
|
})
|
|
end
|
|
|
|
module Executables = struct
|
|
type t =
|
|
{ names : string list
|
|
; link_executables : bool
|
|
; link_flags : Ordered_set_lang.Unexpanded.t
|
|
; modes : Mode.Dict.Set.t
|
|
; buildable : Buildable.t
|
|
}
|
|
|
|
let common_v1 pkgs names public_names ~multi =
|
|
Buildable.v1 >>= fun buildable ->
|
|
field "link_executables" bool ~default:true >>= fun link_executables ->
|
|
field_oslu "link_flags" >>= fun link_flags ->
|
|
map_validate (field "modes" Mode.Dict.Set.t ~default:Mode.Dict.Set.all)
|
|
~f:(fun modes ->
|
|
if Mode.Dict.Set.is_empty modes then
|
|
Error "No compilation mode defined."
|
|
else
|
|
Ok modes)
|
|
>>= fun modes ->
|
|
let t =
|
|
{ names
|
|
; link_executables
|
|
; link_flags
|
|
; modes
|
|
; buildable
|
|
}
|
|
in
|
|
let to_install =
|
|
let ext = if modes.native then ".exe" else ".bc" in
|
|
List.map2 names public_names
|
|
~f:(fun name pub ->
|
|
match pub with
|
|
| None -> None
|
|
| Some pub -> Some ({ Install_conf. src = name ^ ext; dst = Some pub }))
|
|
|> List.filter_map ~f:(fun x -> x)
|
|
in
|
|
match to_install with
|
|
| [] ->
|
|
(field_o "package" Sexp.Ast.loc >>= function
|
|
| None -> return (t, None)
|
|
| Some loc ->
|
|
Loc.warn loc "This field is useless without a (public_name%s ...) field."
|
|
(if multi then "s" else "");
|
|
return (t, None))
|
|
| files ->
|
|
Scope.package_field pkgs >>= fun package ->
|
|
return (t, Some { Install_conf. section = Bin; files; package })
|
|
|
|
let public_name sexp =
|
|
match string sexp with
|
|
| "-" -> None
|
|
| s -> Some s
|
|
|
|
let v1_multi pkgs =
|
|
record
|
|
(field "names" (list string) >>= fun names ->
|
|
map_validate (field_o "public_names" (list public_name)) ~f:(function
|
|
| None -> Ok (List.map names ~f:(fun _ -> None))
|
|
| Some public_names ->
|
|
if List.length public_names = List.length names then
|
|
Ok public_names
|
|
else
|
|
Error "The list of public names must be of the same \
|
|
length as the list of names")
|
|
>>= fun public_names ->
|
|
common_v1 pkgs names public_names ~multi:true)
|
|
|
|
let v1_single pkgs =
|
|
record
|
|
(field "name" string >>= fun name ->
|
|
field_o "public_name" string >>= fun public_name ->
|
|
common_v1 pkgs [name] [public_name] ~multi:false)
|
|
end
|
|
|
|
module Rule = struct
|
|
module Targets = struct
|
|
type t =
|
|
| Static of string list (* List of files in the current directory *)
|
|
| Infer
|
|
end
|
|
|
|
|
|
module Mode = struct
|
|
type t =
|
|
| Standard
|
|
| Fallback
|
|
| Promote
|
|
| Promote_but_delete_on_clean
|
|
| Not_a_rule_stanza
|
|
end
|
|
|
|
type t =
|
|
{ targets : Targets.t
|
|
; deps : Dep_conf.t list
|
|
; action : Action.Unexpanded.t
|
|
; mode : Mode.t
|
|
; locks : String_with_vars.t list
|
|
; loc : Loc.t
|
|
}
|
|
|
|
let v1 sexp =
|
|
match sexp with
|
|
| List (_, (Atom _ :: _)) ->
|
|
{ targets = Infer
|
|
; deps = []
|
|
; action = Action.Unexpanded.t sexp
|
|
; mode = Standard
|
|
; locks = []
|
|
; loc = Loc.none
|
|
}
|
|
| _ ->
|
|
record
|
|
(field "targets" (list file_in_current_dir) >>= fun targets ->
|
|
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
|
field "action" Action.Unexpanded.t >>= fun action ->
|
|
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
|
field_b "fallback" >>= fun fallback ->
|
|
return { targets = Static targets
|
|
; deps
|
|
; action
|
|
; mode = if fallback then Fallback else Standard
|
|
; locks
|
|
; loc = Loc.none
|
|
})
|
|
sexp
|
|
|
|
let ocamllex_v1 loc names =
|
|
let module S = String_with_vars in
|
|
List.map names ~f:(fun name ->
|
|
let src = name ^ ".mll" in
|
|
let dst = name ^ ".ml" in
|
|
{ targets = Static [dst]
|
|
; deps = [File (S.virt_text __POS__ src)]
|
|
; action =
|
|
Chdir
|
|
(S.virt_var __POS__ "ROOT",
|
|
Run (S.virt_text __POS__ "ocamllex",
|
|
[ S.virt_text __POS__ "-q"
|
|
; S.virt_text __POS__ "-o"
|
|
; S.virt_var __POS__ "@"
|
|
; S.virt_var __POS__"<"
|
|
]))
|
|
; mode = Not_a_rule_stanza
|
|
; locks = []
|
|
; loc
|
|
})
|
|
|
|
let ocamlyacc_v1 loc names =
|
|
let module S = String_with_vars in
|
|
List.map names ~f:(fun name ->
|
|
let src = name ^ ".mly" in
|
|
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
|
|
; deps = [File (S.virt_text __POS__ src)]
|
|
; action =
|
|
Chdir
|
|
(S.virt_var __POS__ "ROOT",
|
|
Run (S.virt_text __POS__ "ocamlyacc",
|
|
[S.virt_var __POS__ "<"]))
|
|
; mode = Not_a_rule_stanza
|
|
; locks = []
|
|
; loc
|
|
})
|
|
end
|
|
|
|
module Menhir = struct
|
|
type t =
|
|
{ merge_into : string option
|
|
; flags : String_with_vars.t list
|
|
; modules : string list
|
|
}
|
|
|
|
let v1 =
|
|
record
|
|
(field_o "merge_into" string >>= fun merge_into ->
|
|
field "flags" (list String_with_vars.t) ~default:[] >>= fun flags ->
|
|
field "modules" (list string) >>= fun modules ->
|
|
return
|
|
{ merge_into
|
|
; flags
|
|
; modules
|
|
}
|
|
)
|
|
|
|
let v1_to_rule loc t =
|
|
let module S = String_with_vars in
|
|
let targets n = [n ^ ".ml"; n ^ ".mli"] in
|
|
match t.merge_into with
|
|
| None ->
|
|
List.map t.modules ~f:(fun name ->
|
|
let src = name ^ ".mly" in
|
|
{ Rule.
|
|
targets = Static (targets name)
|
|
; deps = [Dep_conf.File (S.virt_text __POS__ src)]
|
|
; action =
|
|
Chdir
|
|
(S.virt_var __POS__ "ROOT",
|
|
Run (S.virt_text __POS__ "menhir",
|
|
t.flags @ [S.virt_var __POS__ "<"]))
|
|
; mode = Not_a_rule_stanza
|
|
; locks = []
|
|
; loc
|
|
})
|
|
| Some merge_into ->
|
|
let mly m = S.virt_text __POS__ (m ^ ".mly") in
|
|
[{ Rule.
|
|
targets = Static (targets merge_into)
|
|
; deps = List.map ~f:(fun m -> Dep_conf.File (mly m)) t.modules
|
|
; action =
|
|
Chdir
|
|
(S.virt_var __POS__ "ROOT",
|
|
Run (S.virt_text __POS__ "menhir",
|
|
List.concat
|
|
[ [ S.virt_text __POS__ "--base"
|
|
; S.virt_var __POS__ ("path-no-dep:" ^ merge_into)
|
|
]
|
|
; t.flags
|
|
; [ S.virt_var __POS__ "^" ]
|
|
]))
|
|
; mode = Not_a_rule_stanza
|
|
; locks = []
|
|
; loc
|
|
}]
|
|
end
|
|
|
|
module Provides = struct
|
|
type t =
|
|
{ name : string
|
|
; file : string
|
|
}
|
|
|
|
(* let v1 sexp =
|
|
match sexp with
|
|
| Atom (_, s) ->
|
|
{ name = s
|
|
; file =
|
|
match String.lsplit2 s ~on:':' with
|
|
| None -> s
|
|
| Some (_, s) -> s
|
|
}
|
|
| List (_, [Atom (_, s); List (_, [Atom (_, "file"); Atom (_, file)])]) ->
|
|
{ name = s
|
|
; file
|
|
}
|
|
| sexp ->
|
|
of_sexp_error sexp "[<name>] or [<name> (file <file>)] expected"*)
|
|
end
|
|
|
|
module Alias_conf = struct
|
|
type t =
|
|
{ name : string
|
|
; deps : Dep_conf.t list
|
|
; action : Action.Unexpanded.t option
|
|
; locks : String_with_vars.t list
|
|
; package : Package.t option
|
|
}
|
|
|
|
let v1 pkgs =
|
|
record
|
|
(field "name" string >>= fun name ->
|
|
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
|
field_o "package" (Scope.package pkgs) >>= fun package ->
|
|
field_o "action" Action.Unexpanded.t >>= fun action ->
|
|
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
|
return
|
|
{ name
|
|
; deps
|
|
; action
|
|
; package
|
|
; locks
|
|
})
|
|
end
|
|
|
|
module Copy_files = struct
|
|
type t = { add_line_directive : bool
|
|
; glob : String_with_vars.t
|
|
}
|
|
|
|
let v1 = String_with_vars.t
|
|
end
|
|
|
|
module Stanza = struct
|
|
type t =
|
|
| Library of Library.t
|
|
| Executables of Executables.t
|
|
| Rule of Rule.t
|
|
| Provides of Provides.t
|
|
| Install of Install_conf.t
|
|
| Alias of Alias_conf.t
|
|
| Copy_files of Copy_files.t
|
|
end
|
|
|
|
module Stanzas = struct
|
|
type t = Stanza.t list
|
|
|
|
type syntax = OCaml | Plain
|
|
|
|
open Stanza
|
|
|
|
let rules l = List.map l ~f:(fun x -> Rule x)
|
|
|
|
let execs (exe, install) =
|
|
match install with
|
|
| None -> [Executables exe]
|
|
| Some i -> [Executables exe; Install i]
|
|
|
|
exception Include_loop of Path.t * (Loc.t * Path.t) list
|
|
|
|
let rec v1 pkgs ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t =
|
|
sum
|
|
[ cstr "library" (Library.v1 pkgs @> nil) (fun x -> [Library x])
|
|
; cstr "executable" (Executables.v1_single pkgs @> nil) execs
|
|
; cstr "executables" (Executables.v1_multi pkgs @> nil) execs
|
|
; cstr_loc "rule" (Rule.v1 @> nil) (fun loc x -> [Rule { x with loc }])
|
|
; cstr_loc "ocamllex" (list string @> nil) (fun loc x -> rules (Rule.ocamllex_v1 loc x))
|
|
; cstr_loc "ocamlyacc" (list string @> nil) (fun loc x -> rules (Rule.ocamlyacc_v1 loc x))
|
|
; cstr_loc "menhir" (Menhir.v1 @> nil) (fun loc x -> rules (Menhir.v1_to_rule loc x))
|
|
; cstr "install" (Install_conf.v1 pkgs @> nil) (fun x -> [Install x])
|
|
; cstr "alias" (Alias_conf.v1 pkgs @> nil) (fun x -> [Alias x])
|
|
; cstr "copy_files" (Copy_files.v1 @> nil)
|
|
(fun glob -> [Copy_files {add_line_directive = false; glob}])
|
|
; cstr "copy_files#" (Copy_files.v1 @> nil)
|
|
(fun glob -> [Copy_files {add_line_directive = true; glob}])
|
|
(* Just for validation and error messages *)
|
|
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
|
|
; cstr_loc "include" (relative_file @> nil) (fun loc fn ->
|
|
let include_stack = (loc, file) :: include_stack in
|
|
let dir = Path.parent file in
|
|
let file = Path.relative dir fn in
|
|
if not (Path.exists file) then
|
|
Loc.fail loc "File %s doesn't exist."
|
|
(Path.to_string_maybe_quoted file);
|
|
if List.exists include_stack ~f:(fun (_, f) -> f = file) then
|
|
raise (Include_loop (file, include_stack));
|
|
let sexps = Sexp.load ~fname:(Path.to_string file) ~mode:Many in
|
|
parse pkgs sexps ~default_version:Jbuild_version.V1 ~file ~include_stack)
|
|
]
|
|
|
|
and select
|
|
: Jbuild_version.t
|
|
-> Scope.t
|
|
-> file:Path.t
|
|
-> include_stack:(Loc.t * Path.t) list
|
|
-> Stanza.t list Sexp.Of_sexp.t = function
|
|
| V1 -> v1
|
|
|
|
and parse ~default_version ~file ~include_stack pkgs sexps =
|
|
let versions, sexps =
|
|
List.partition_map sexps ~f:(function
|
|
| List (loc, [Atom (_, "jbuild_version"); ver]) ->
|
|
Inl (Jbuild_version.t ver, loc)
|
|
| sexp -> Inr sexp)
|
|
in
|
|
let version =
|
|
match versions with
|
|
| [] -> default_version
|
|
| [(v, _)] -> v
|
|
| _ :: (_, loc) :: _ ->
|
|
Loc.fail loc "jbuild_version specified too many times"
|
|
in
|
|
List.concat_map sexps ~f:(select version pkgs ~file ~include_stack)
|
|
|
|
let parse ?(default_version=Jbuild_version.latest_stable) ~file pkgs sexps =
|
|
try
|
|
parse pkgs sexps ~default_version ~include_stack:[] ~file
|
|
with
|
|
| Include_loop (_, []) -> assert false
|
|
| Include_loop (file, last :: rest) ->
|
|
let loc = fst (Option.value (List.last rest) ~default:last) in
|
|
let line_loc (loc, file) =
|
|
sprintf "%s:%d"
|
|
(Path.to_string_maybe_quoted file)
|
|
loc.Loc.start.pos_lnum
|
|
in
|
|
Loc.fail loc
|
|
"Recursive inclusion of jbuild files detected:\n\
|
|
File %s is included from %s%s"
|
|
(Path.to_string_maybe_quoted file)
|
|
(line_loc last)
|
|
(String.concat ~sep:""
|
|
(List.map rest ~f:(fun x ->
|
|
sprintf
|
|
"\n--> included from %s"
|
|
(line_loc x))))
|
|
|
|
let lib_names ts =
|
|
List.fold_left ts ~init:String_set.empty ~f:(fun acc (_, _, stanzas) ->
|
|
List.fold_left stanzas ~init:acc ~f:(fun acc -> function
|
|
| Stanza.Library lib ->
|
|
String_set.add lib.name
|
|
(match lib.public with
|
|
| None -> acc
|
|
| Some { name; _ } -> String_set.add name acc)
|
|
| _ -> acc))
|
|
end
|