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

4.02.3 compatiblity

This commit is contained in:
Jérémie Dimino 2017-02-26 21:28:30 +00:00
parent 304d7becbc
commit 27a299437d
19 changed files with 157 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
jbuilder.opam
View File

@ -10,7 +10,7 @@ build: [
["ocaml" "bootstrap.ml"]
["./boot.exe" "-j" jobs]
]
available: [ ocaml-version >= "4.03.0" ]
available: [ ocaml-version >= "4.02.3" ]
descr: "
Fast, portable and opinionated build system

6
src/build.ml
View File

@ -18,9 +18,13 @@ type lib_dep_kind =
type lib_deps = lib_dep_kind String_map.t
module Repr = struct
type ('a, 'b) prim =
{ targets : Path.t list
; exec : 'a -> 'b Future.t
}
type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('a, 'b) t
| Prim : { targets : Path.t list; exec : 'a -> 'b Future.t } -> ('a, 'b) t
| Prim : ('a, 'b) prim -> ('a, 'b) t
| Store_vfile : 'a Vspec.t -> ('a, unit) t
| Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t

6
src/build.mli
View File

@ -103,9 +103,13 @@ type lib_deps = lib_dep_kind String_map.t
module Repr : sig
type ('a, 'b) prim =
{ targets : Path.t list
; exec : 'a -> 'b Future.t
}
type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('a, 'b) t
| Prim : { targets : Path.t list; exec : 'a -> 'b Future.t } -> ('a, 'b) t
| Prim : ('a, 'b) prim -> ('a, 'b) t
| Store_vfile : 'a Vspec.t -> ('a, unit) t
| Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t

10
src/build_system.ml
View File

@ -6,10 +6,16 @@ module Pmap = Path.Map
module Vspec = Build.Vspec
module Exec_status = struct
module Starting = struct
type t = { for_file : Path.t }
end
module Running = struct
type t = { for_file : Path.t; future : unit Future.t }
end
type t =
| Not_started of (targeting:Path.t -> unit Future.t)
| Starting of { for_file : Path.t }
| Running of { for_file : Path.t; future : unit Future.t }
| Starting of Starting.t
| Running of Running.t
end
module Rule = struct

22
src/context.ml
View File

@ -2,7 +2,13 @@ open Import
open Future
module Kind = struct
type t = Default | Opam of { root : string; switch : string }
module Opam = struct
type t =
{ root : string
; switch : string
}
end
type t = Default | Opam of Opam.t
end
type t =
@ -152,13 +158,17 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin =
| Error (key, _, _) ->
die "variable %S present twice in the output of `%s`" key ocamlc_config_cmd
in
let get var =
let get ?default var =
match String_map.find var ocamlc_config with
| None -> die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
| Some s -> s
| None ->
match default with
| Some x -> x
| None ->
die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
in
let get_bool var =
match get var with
let get_bool ?default var =
match get ?default:(Option.map default ~f:string_of_bool) var with
| "true" -> true
| "false" -> false
| _ -> die "variable %S is neither 'true' neither 'false' in the output of `%s`"
@ -210,7 +220,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin =
; default_executable_name = get "default_executable_name"
; host = get "host"
; target = get "target"
; flambda = get_bool "flambda"
; flambda = get_bool "flambda" ~default:false
; exec_magic_number = get "exec_magic_number"
; cmi_magic_number = get "cmi_magic_number"
; cmo_magic_number = get "cmo_magic_number"

8
src/context.mli
View File

@ -21,7 +21,13 @@
open! Import
module Kind : sig
type t = Default | Opam of { root : string; switch : string }
module Opam : sig
type t =
{ root : string
; switch : string
}
end
type t = Default | Opam of Opam.t
end
type t =

2
src/future.ml
View File

@ -313,7 +313,7 @@ module Scheduler = struct
in
match finished with
| [] ->
Unix.sleepf 0.001;
ignore (Unix.select [] [] [] 0.001);
wait_win32 ()
| _ ->
List.iter finished ~f:(fun (job, status) ->

2
src/glob_lexer.mli
View File

@ -1 +1,3 @@
open Import
val parse_string : string -> (Jbuilder_re.Re.t, int * string) result

4
src/glob_lexer.mll
View File

@ -60,8 +60,8 @@ and char_set st = parse
let parse_string s =
let lb = Lexing.from_string s in
match initial lb with
| re -> Ok re
| re -> Import.Ok re
| exception Failure msg ->
Error (Lexing.lexeme_start lb, msg)
Import.Error (Lexing.lexeme_start lb, msg)
}

15
src/import.ml
View File

@ -16,14 +16,16 @@ let ksprintf = Printf.ksprintf
exception Code_error of string
let code_errorf fmt = ksprintf (fun msg -> raise (Code_error msg)) fmt
type ('a, 'b) result =
| Ok of 'a
| Error of 'b
type ('a, 'b) either =
| Inl of 'a
| Inr of 'b
module List = struct
type 'a t = 'a list =
| []
| ( :: ) of 'a * 'a t
type 'a t = 'a list
include ListLabels
@ -193,8 +195,11 @@ module String = struct
len >= suffix_len &&
sub s ~pos:(len - suffix_len) ~len:suffix_len = suffix
let capitalize_ascii = String.capitalize_ascii
let uncapitalize_ascii = String.uncapitalize_ascii
include struct
[@@@warning "-3"]
let capitalize_ascii = String.capitalize
let uncapitalize_ascii = String.uncapitalize
end
let split_words s =
let rec skip_blanks i =

26
src/install.ml
View File

@ -33,19 +33,19 @@ module Section = struct
let t =
let open Sexp.Of_sexp in
sum
[ cstr "lib" [] Lib
; cstr "libexec" [] Libexec
; cstr "bin" [] Bin
; cstr "sbin" [] Sbin
; cstr "toplevel" [] Toplevel
; cstr "share" [] Share
; cstr "share_root" [] Share_root
; cstr "etc" [] Etc
; cstr "doc" [] Doc
; cstr "stublibs" [] Stublibs
; cstr "man" [] Man
; cstr "misc" [] Misc
enum
[ "lib" , Lib
; "libexec" , Libexec
; "bin" , Bin
; "sbin" , Sbin
; "toplevel" , Toplevel
; "share" , Share
; "share_root" , Share_root
; "etc" , Etc
; "doc" , Doc
; "stublibs" , Stublibs
; "man" , Man
; "misc" , Misc
]
end

10
src/jbuild_load.ml
View File

@ -2,12 +2,14 @@ open Import
open Jbuild_types
module Jbuilds = struct
type script =
{ dir : Path.t
; visible_packages : Package.t String_map.t
}
type one =
| Literal of Path.t * Stanza.t list
| Script of
{ dir : Path.t
; visible_packages : Package.t String_map.t
}
| Script of script
type t = one list

85
src/jbuild_types.ml
View File

@ -127,10 +127,10 @@ module User_action = struct
let rec t a sexp =
sum
[ cstr_rest "run" [a] a (fun prog args -> Run (prog, args))
; cstr "chdir" [a; t a] (fun dn t -> Chdir (dn, t))
; cstr "setenv" [a; a; t a] (fun k v t -> Setenv (k, v, t))
; cstr "with-stdout-to" [a; t a] (fun fn t -> With_stdout_to (fn, t))
[ cstr_rest "run" (a @> nil) a (fun prog args -> Run (prog, args))
; cstr "chdir" (a @> t a @> nil) (fun dn t -> Chdir (dn, t))
; cstr "setenv" (a @> a @> t a @> nil) (fun k v t -> Setenv (k, v, t))
; cstr "with-stdout-to" (a @> t a @> nil) (fun fn t -> With_stdout_to (fn, t))
]
sexp
@ -231,11 +231,14 @@ module Dep_conf = struct
let t =
let t =
let cstr name f =
cstr name (String_with_vars.t @> nil) f
in
sum
[ cstr "file" [String_with_vars.t] (fun x -> File x)
; cstr "alias" [String_with_vars.t] (fun x -> Alias x)
; cstr "glob_files" [String_with_vars.t] (fun x -> Glob_files x)
; cstr "files_recursively_in" [String_with_vars.t] (fun x -> Files_recursively_in x)
[ cstr "file" (fun x -> File x)
; cstr "alias" (fun x -> Alias x)
; cstr "glob_files" (fun x -> Glob_files x)
; cstr "files_recursively_in" (fun x -> Files_recursively_in x)
]
in
fun sexp ->
@ -256,16 +259,17 @@ module Dep_conf = struct
end
module Preprocess = struct
type pps = { pps : Pp_set.t; flags : string list }
type t =
| No_preprocessing
| Command of String_with_vars.t
| Pps of { pps : Pp_set.t; flags : string list }
| Pps of pps
let t =
sum
[ cstr "no_preprocessing" [] No_preprocessing
; cstr "command" [String_with_vars.t] (fun x -> Command x)
; cstr "pps" [list Pp_or_flag.t] (fun l ->
[ cstr "no_preprocessing" nil No_preprocessing
; cstr "command" (String_with_vars.t @> nil) (fun x -> Command x)
; cstr "pps" (list Pp_or_flag.t @> nil) (fun l ->
let pps, flags = Pp_or_flag.split l in
Pps { pps = Pp_set.of_list pps; flags })
]
@ -337,9 +341,11 @@ module Lib_dep = struct
; file : string
}
type select = { result_fn : string; choices : choice list }
type t =
| Direct of string
| Select of { result_fn : string; choices : choice list }
| Select of select
let choice = function
| List (_, l) as sexp ->
@ -363,10 +369,10 @@ module Lib_dep = struct
let sexp_of_choice { lits; file } : Sexp.t =
List (List.fold_right lits ~init:[Atom "->"; Atom file]
~f:(fun lit acc : Sexp.t list ->
~f:(fun lit acc ->
match lit with
| Pos s -> Atom s :: acc
| Neg s -> Atom ("!" ^ s) :: acc))
| Pos s -> Sexp.Atom s :: acc
| Neg s -> Sexp.Atom ("!" ^ s) :: acc))
let t = function
| Atom (_, s) ->
@ -457,10 +463,10 @@ module Library = struct
| Ppx_rewriter
let t =
sum
[ cstr "normal" [] Normal
; cstr "ppx_type_conv_plugin" [] Ppx_type_conv_plugin
; cstr "ppx_rewriter" [] Ppx_rewriter
enum
[ "normal" , Normal
; "ppx_type_conv_plugin" , Ppx_type_conv_plugin
; "ppx_rewriter" , Ppx_rewriter
]
end
@ -779,36 +785,35 @@ module Stanza = struct
let v1 =
sum
[ cstr' "library" [Library.v1] (fun x -> Library x)
; cstr' "executables" [Executables.v1] (fun x -> Executables x)
; cstr' "rule" [Rule.v1] (fun x -> Rule x)
; cstr' "ocamllex" [Ocamllex.v1] (fun x -> Ocamllex x)
; cstr' "ocamlyacc" [Ocamlyacc.v1] (fun x -> Ocamlyacc x)
; cstr' "provides" [Provides.v1] (fun x -> Provides x)
; cstr' "install" [Install_conf.v1] (fun x -> Install x)
; cstr' "alias" [Alias_conf.v1] (fun x -> Alias x)
[ cstr' "library" (Library.v1 @> nil) (fun x -> Library x)
; cstr' "executables" (Executables.v1 @> nil) (fun x -> Executables x)
; cstr' "rule" (Rule.v1 @> nil) (fun x -> Rule x)
; cstr' "ocamllex" (Ocamllex.v1 @> nil) (fun x -> Ocamllex x)
; cstr' "ocamlyacc" (Ocamlyacc.v1 @> nil) (fun x -> Ocamlyacc x)
; cstr' "provides" (Provides.v1 @> nil) (fun x -> Provides x)
; cstr' "install" (Install_conf.v1 @> nil) (fun x -> Install x)
; cstr' "alias" (Alias_conf.v1 @> nil) (fun x -> Alias x)
(* Just for validation and error messages *)
; cstr "jbuild_version" [Jbuild_version.t] (fun _ -> None)
; cstr "use_meta_lang" [] None
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> None)
]
let vjs =
let ign name = cstr name [fun _ -> ()] (fun () -> None) in
let ign name = cstr name ((fun _ -> ()) @> nil) (fun () -> None) in
sum
[ cstr' "library" [Library.vjs] (fun x -> Library x)
; cstr' "executables" [Executables.vjs] (fun x -> Executables x)
; cstr' "rule" [Rule.vjs] (fun x -> Rule x)
; cstr' "ocamllex" [Ocamllex.vjs] (fun x -> Ocamllex x)
; cstr' "ocamlyacc" [Ocamlyacc.vjs] (fun x -> Ocamlyacc x)
; cstr' "provides" [Provides.vjs] (fun x -> Provides x)
; cstr' "install" [Install_conf.vjs] (fun x -> Install x)
; cstr' "alias" [Alias_conf.vjs] (fun x -> Alias x)
[ cstr' "library" (Library.vjs @> nil) (fun x -> Library x)
; cstr' "executables" (Executables.vjs @> nil) (fun x -> Executables x)
; cstr' "rule" (Rule.vjs @> nil) (fun x -> Rule x)
; cstr' "ocamllex" (Ocamllex.vjs @> nil) (fun x -> Ocamllex x)
; cstr' "ocamlyacc" (Ocamlyacc.vjs @> nil) (fun x -> Ocamlyacc x)
; cstr' "provides" (Provides.vjs @> nil) (fun x -> Provides x)
; cstr' "install" (Install_conf.vjs @> nil) (fun x -> Install x)
; cstr' "alias" (Alias_conf.vjs @> nil) (fun x -> Alias x)
; ign "enforce_style"
; ign "toplevel_expect_tests"
; ign "unified_tests"
; ign "embed"
(* Just for validation and error messages *)
; cstr "jbuild_version" [Jbuild_version.t] (fun _ -> None)
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> None)
]
let select : Jbuild_version.t -> t option Sexp.Of_sexp.t = function

4
src/lib.ml
View File

@ -71,10 +71,10 @@ let describe = function
let link_flags ts ~mode =
Arg_spec.S
(include_flags ts ::
List.map ts ~f:(fun t : _ Arg_spec.t ->
List.map ts ~f:(fun t ->
match t with
| External pkg ->
Deps_rel (pkg.dir, Mode.Dict.get pkg.archives mode)
Arg_spec.Deps_rel (pkg.dir, Mode.Dict.get pkg.archives mode)
| Internal (dir, lib) ->
Dep_rel (dir, lib.name ^ Mode.compiled_lib_ext mode)))

6
src/mode.ml
View File

@ -6,9 +6,9 @@ let all = [Byte; Native]
let t =
let open Sexp.Of_sexp in
sum
[ cstr "byte" [] Byte
; cstr "native" [] Native
enum
[ "byte" , Byte
; "native" , Native
]
let choose byte native = function

33
src/sexp.ml
View File

@ -258,28 +258,33 @@ module Of_sexp = struct
module Constructor_args_spec = struct
type 'a conv = 'a t
type ('a, 'b) t =
| [] : ('a, 'a) t
| ( :: ) : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
| Nil : ('a, 'a) t
| Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
let rec convert : type a b c. (a, b) t -> (b, c) rest -> Ast.t -> Ast.t list -> a -> c
= fun t rest sexp sexps f ->
match t, rest, sexps with
| [], No_rest, [] -> f
| [], Many _ , [] -> f []
| _ :: _, _, [] -> of_sexp_error sexp "not enough arguments"
| [], No_rest, _ :: _ -> of_sexp_error sexp "too many arguments"
| [], Many conv, l -> f (List.map l ~f:conv)
| conv :: t, _, s :: sexps ->
| Nil, No_rest, [] -> f
| Nil, Many _ , [] -> f []
| Cons _, _, [] -> of_sexp_error sexp "not enough arguments"
| Nil, No_rest, _ :: _ -> of_sexp_error sexp "too many arguments"
| Nil, Many conv, l -> f (List.map l ~f:conv)
| Cons (conv, t), _, s :: sexps ->
convert t rest sexp sexps (f (conv s))
end
let nil = Constructor_args_spec.Nil
let ( @> ) a b = Constructor_args_spec.Cons (a, b)
module Constructor_spec = struct
type 'a t =
T : { name : string
; args : ('a, 'b) Constructor_args_spec.t
; rest : ('b, 'c) rest
; make : 'a
} -> 'c t
type ('a, 'b, 'c) unpacked =
{ name : string
; args : ('a, 'b) Constructor_args_spec.t
; rest : ('b, 'c) rest
; make : 'a
}
type 'a t = T : (_, _, 'a) unpacked -> 'a t
end
let cstr_rest name args rest make =

13
src/sexp.mli
View File

@ -65,11 +65,14 @@ module Of_sexp : sig
end
module Constructor_args_spec : sig
type 'a conv = 'a t
type ('a, 'b) t =
| [] : ('a, 'a) t
| ( :: ) : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
end with type 'a conv := 'a t
type ('a, 'b) t
end
val nil : ('a, 'a) Constructor_args_spec.t
val ( @> )
: 'a t
-> ('b, 'c) Constructor_args_spec.t
-> ('a -> 'b, 'c) Constructor_args_spec.t
val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t
val cstr_rest

2
src/workspace.ml
View File

@ -44,7 +44,7 @@ let t sexps =
List.fold_left sexps ~init:(None, []) ~f:(fun (merlin_ctx, ctxs) sexp ->
let ctx =
sum
[ cstr "context" [Context.t] (fun x -> x) ]
[ cstr "context" (Context.t @> nil) (fun x -> x) ]
sexp
in
let name = Context.name ctx in

5
vendor/cmdliner/src/result.ml vendored
View File

@ -1,2 +1,3 @@
type nonrec ('ok, 'err) result = ('ok, 'err) result
type ('ok, 'err) result =
| Ok of 'ok
| Error of 'err