Add enabled_if to aliases/tests
This field controls whether the alias/test will be run or not. Boolean expressions are defined using the Blang.t type. This type represents simple boolean expressions that become useful when we allow to interpolate variables into them. Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
e59feacb6d
commit
3d9612f95c
|
@ -569,6 +569,10 @@ The syntax is as follows:
|
|||
- ``(locks (<lock-names>))`` specify that the action must be run while
|
||||
holding the following locks. See the `Locks`_ section for more details.
|
||||
|
||||
- ``(enabled_if <blang expression>)`` specifies the boolean condition that must
|
||||
be true for the tests to run. The condition is specified using the blang_, and
|
||||
the field allows for variables_ to appear in the expressions.
|
||||
|
||||
The typical use of the ``alias`` stanza is to define tests:
|
||||
|
||||
.. code:: scheme
|
||||
|
@ -824,6 +828,36 @@ doesn't start by `-`, you can simply quote it: ``("x" y z)``.
|
|||
Most fields using the ordered set language also support `Variables expansion`_.
|
||||
Variables are expanded after the set language is interpreted.
|
||||
|
||||
.. _blang:
|
||||
|
||||
Boolean Language
|
||||
----------------
|
||||
|
||||
The boolean language allows the user to define simple boolean expressions that
|
||||
dune can evaluate. Here's a semi formal specification of the language:
|
||||
|
||||
.. code::
|
||||
|
||||
op := '=' | '<' | '>' | '<>' | '>=' | '<='
|
||||
|
||||
expr := (and <expr>+)
|
||||
| (or <expr>+)
|
||||
| (<op> <template> <template>)
|
||||
| <template>
|
||||
|
||||
After an expression is evaluated, it must be exactly the string ``true`` or
|
||||
``false`` to be considered as a boolean. Any other value will be treated as an
|
||||
error.
|
||||
|
||||
Here's a simple example of a condition that expresses running on OSX and having
|
||||
an flambda compiler with the help of variable expansion:
|
||||
|
||||
.. code:: scheme
|
||||
|
||||
(and %{ocamlc-config:flambda} (= %{ocamlc-config:system} macosx))
|
||||
|
||||
.. _variables:
|
||||
|
||||
Variables expansion
|
||||
-------------------
|
||||
|
||||
|
|
|
@ -0,0 +1,45 @@
|
|||
open! Stdune
|
||||
|
||||
module Op = struct
|
||||
type t =
|
||||
| Eq
|
||||
| Gt
|
||||
| Gte
|
||||
| Lte
|
||||
| Lt
|
||||
| Neq
|
||||
|
||||
let eval t (x : Ordering.t) =
|
||||
match t, x with
|
||||
| (Eq | Gte | Lte) , Eq
|
||||
| (Lt | Lte) , Lt
|
||||
| (Gt | Gte) , Gt -> true
|
||||
| _, _ -> false
|
||||
end
|
||||
|
||||
type 'a t =
|
||||
| Expr of 'a
|
||||
| And of 'a t list
|
||||
| Or of 'a t list
|
||||
| Compare of Op.t * 'a * 'a
|
||||
|
||||
type 'a expander =
|
||||
{ f : 'value. mode:'value String_with_vars.Mode.t
|
||||
-> 'a
|
||||
-> Loc.t * 'value
|
||||
}
|
||||
|
||||
let rec eval_bool t ~dir ~(f : 'a expander) =
|
||||
match t with
|
||||
| Expr a ->
|
||||
begin match f.f ~mode:Single a with
|
||||
| _, String "true" -> true
|
||||
| _, String "false" -> false
|
||||
| loc, _ -> Loc.fail loc "This value must be either true or false"
|
||||
end
|
||||
| And xs -> List.for_all ~f:(eval_bool ~f ~dir) xs
|
||||
| Or xs -> List.exists ~f:(eval_bool ~f ~dir) xs
|
||||
| Compare (op, x, y) ->
|
||||
let ((_, x), (_, y)) = (f.f ~mode:Many x, f.f ~mode:Many y) in
|
||||
Value.L.compare_vals ~dir x y
|
||||
|> Op.eval op
|
|
@ -0,0 +1,25 @@
|
|||
open Stdune
|
||||
|
||||
module Op : sig
|
||||
type t =
|
||||
| Eq
|
||||
| Gt
|
||||
| Gte
|
||||
| Lte
|
||||
| Lt
|
||||
| Neq
|
||||
end
|
||||
|
||||
type 'a t =
|
||||
| Expr of 'a
|
||||
| And of 'a t list
|
||||
| Or of 'a t list
|
||||
| Compare of Op.t * 'a * 'a
|
||||
|
||||
type 'a expander =
|
||||
{ f : 'value. mode:'value String_with_vars.Mode.t
|
||||
-> 'a
|
||||
-> Loc.t * 'value
|
||||
}
|
||||
|
||||
val eval_bool : 'a t -> dir:Path.t -> f:'a expander -> bool
|
|
@ -590,6 +590,7 @@ module Gen(P : Install_rules.Params) = struct
|
|||
; package = t.package
|
||||
; deps = t.deps
|
||||
; action = None
|
||||
; enabled_if = t.enabled_if
|
||||
} in
|
||||
match test_kind (loc, s) with
|
||||
| `Regular ->
|
||||
|
|
|
@ -378,6 +378,45 @@ module Preprocess = struct
|
|||
| _ -> []
|
||||
end
|
||||
|
||||
module Blang = struct
|
||||
type 'a t = 'a Blang.t
|
||||
|
||||
open Blang
|
||||
let ops =
|
||||
[ "=", Op.Eq
|
||||
; ">=", Gte
|
||||
; "<=", Lt
|
||||
; ">", Gt
|
||||
; "<", Lt
|
||||
; "<>", Neq
|
||||
]
|
||||
|
||||
let t =
|
||||
let ops =
|
||||
List.map ops ~f:(fun (name, op) ->
|
||||
( name
|
||||
, (let%map x = String_with_vars.t
|
||||
and y = String_with_vars.t
|
||||
in
|
||||
Compare (op, x, y))))
|
||||
in
|
||||
let t =
|
||||
fix begin fun (t : String_with_vars.t Blang.t Sexp.Of_sexp.t) ->
|
||||
if_list
|
||||
~then_:(
|
||||
[ "or", repeat t >>| (fun x -> Or x)
|
||||
; "and", repeat t >>| (fun x -> And x)
|
||||
] @ ops
|
||||
|> sum)
|
||||
~else_:(String_with_vars.t >>| fun v -> Expr v)
|
||||
end
|
||||
in
|
||||
let%map () = Syntax.since Stanza.syntax (1, 1)
|
||||
and t = t
|
||||
in
|
||||
t
|
||||
end
|
||||
|
||||
module Per_module = struct
|
||||
include Per_item.Make(Module.Name)
|
||||
|
||||
|
@ -1500,6 +1539,7 @@ module Alias_conf = struct
|
|||
; action : (Loc.t * Action.Unexpanded.t) option
|
||||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
; enabled_if : String_with_vars.t Blang.t option
|
||||
}
|
||||
|
||||
let alias_name =
|
||||
|
@ -1516,12 +1556,14 @@ module Alias_conf = struct
|
|||
and action = field_o "action" (located Action.Unexpanded.t)
|
||||
and locks = field "locks" (list String_with_vars.t) ~default:[]
|
||||
and deps = field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
|
||||
and enabled_if = field_o "enabled_if" Blang.t
|
||||
in
|
||||
{ name
|
||||
; deps
|
||||
; action
|
||||
; package
|
||||
; locks
|
||||
; enabled_if
|
||||
})
|
||||
end
|
||||
|
||||
|
@ -1531,6 +1573,7 @@ module Tests = struct
|
|||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
; deps : Dep_conf.t Bindings.t
|
||||
; enabled_if : String_with_vars.t Blang.t option
|
||||
}
|
||||
|
||||
let gen_parse names =
|
||||
|
@ -1543,6 +1586,7 @@ module Tests = struct
|
|||
and modes = field "modes" Executables.Link_mode.Set.t
|
||||
~default:Executables.Link_mode.Set.default
|
||||
and deps = field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
|
||||
and enabled_if = field_o "enabled_if" Blang.t
|
||||
in
|
||||
{ exes =
|
||||
{ Executables.
|
||||
|
@ -1555,6 +1599,7 @@ module Tests = struct
|
|||
; locks
|
||||
; package
|
||||
; deps
|
||||
; enabled_if
|
||||
})
|
||||
|
||||
let multi = gen_parse (field "names" (list (located string)))
|
||||
|
|
|
@ -335,6 +335,7 @@ module Alias_conf : sig
|
|||
; action : (Loc.t * Action.Unexpanded.t) option
|
||||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
; enabled_if : String_with_vars.t Blang.t option
|
||||
}
|
||||
end
|
||||
|
||||
|
@ -359,6 +360,7 @@ module Tests : sig
|
|||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
; deps : Dep_conf.t Bindings.t
|
||||
; enabled_if : String_with_vars.t Blang.t option
|
||||
}
|
||||
end
|
||||
|
||||
|
|
|
@ -70,6 +70,19 @@ let add_alias sctx ~dir ~name ~stamp ?(locks=[]) build =
|
|||
SC.add_alias_action sctx alias ~locks ~stamp build
|
||||
|
||||
let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) =
|
||||
let enabled =
|
||||
match alias_conf.enabled_if with
|
||||
| None -> true
|
||||
| Some blang ->
|
||||
let f : String_with_vars.t Blang.expander =
|
||||
{ f = fun ~mode sw ->
|
||||
( String_with_vars.loc sw
|
||||
, Super_context.expand_vars sctx ~scope ~mode ~dir sw
|
||||
)
|
||||
} in
|
||||
Blang.eval_bool blang ~dir ~f
|
||||
in
|
||||
if enabled then
|
||||
let stamp =
|
||||
let module S = Sexp.To_sexp in
|
||||
Sexp.List
|
||||
|
|
|
@ -0,0 +1,10 @@
|
|||
type t = bool
|
||||
|
||||
let compare x y =
|
||||
match x, y with
|
||||
| true, true
|
||||
| false, false -> Ordering.Eq
|
||||
| true, false -> Gt
|
||||
| false, true -> Lt
|
||||
|
||||
let to_string = string_of_bool
|
|
@ -0,0 +1,5 @@
|
|||
type t = bool
|
||||
|
||||
val compare : t -> t -> Ordering.t
|
||||
|
||||
val to_string : t -> string
|
|
@ -446,7 +446,6 @@ module Of_sexp = struct
|
|||
String.Map.iteri map ~f:(Hashtbl.add tbl);
|
||||
tbl
|
||||
|
||||
|
||||
let find_cstr cstrs loc name ctx values =
|
||||
match List.assoc cstrs name with
|
||||
| Some t ->
|
||||
|
|
|
@ -18,6 +18,7 @@ module Set = Set
|
|||
module Staged = Staged
|
||||
module String = String
|
||||
module Char = Char
|
||||
module Bool = Bool
|
||||
module Sexp = Sexp
|
||||
module Path = Path
|
||||
module Fmt = Fmt
|
||||
|
|
|
@ -79,6 +79,14 @@ val dump_env : t -> dir:Path.t -> (unit, Sexp.t list) Build.t
|
|||
val find_scope_by_dir : t -> Path.t -> Scope.t
|
||||
val find_scope_by_name : t -> Dune_project.Name.t -> Scope.t
|
||||
|
||||
val expand_vars
|
||||
: t
|
||||
-> mode:'a String_with_vars.Mode.t
|
||||
-> scope:Scope.t
|
||||
-> dir:Path.t -> ?bindings:Pform.Map.t
|
||||
-> String_with_vars.t
|
||||
-> 'a
|
||||
|
||||
val expand_vars_string
|
||||
: t
|
||||
-> scope:Scope.t
|
||||
|
|
23
src/value.ml
23
src/value.ml
|
@ -1,10 +1,17 @@
|
|||
open Stdune
|
||||
open Import
|
||||
|
||||
type t =
|
||||
| String of string
|
||||
| Dir of Path.t
|
||||
| Path of Path.t
|
||||
|
||||
let sexp_of_t =
|
||||
let open Sexp.To_sexp in
|
||||
function
|
||||
| String s -> (pair string string) ("string", s)
|
||||
| Path p -> (pair string Path.sexp_of_t) ("path", p)
|
||||
| Dir p -> (pair string Path.sexp_of_t) ("dir", p)
|
||||
|
||||
let string_of_path ~dir p = Path.reach ~from:dir p
|
||||
|
||||
let to_string t ~dir =
|
||||
|
@ -13,6 +20,17 @@ let to_string t ~dir =
|
|||
| Dir p
|
||||
| Path p -> string_of_path ~dir p
|
||||
|
||||
let compare_vals ~dir x y =
|
||||
match x, y with
|
||||
| String x, String y ->
|
||||
String.compare x y
|
||||
| (Path x | Dir x), (Path y | Dir y) ->
|
||||
Path.compare x y
|
||||
| String x, (Path _ | Dir _) ->
|
||||
String.compare x (to_string ~dir y)
|
||||
| (Path _ | Dir _), String y ->
|
||||
String.compare (to_string ~dir x) y
|
||||
|
||||
let to_path ?error_loc t ~dir =
|
||||
match t with
|
||||
| String s -> Path.relative ?error_loc dir s
|
||||
|
@ -22,6 +40,9 @@ let to_path ?error_loc t ~dir =
|
|||
module L = struct
|
||||
let to_strings t ~dir = List.map t ~f:(to_string ~dir)
|
||||
|
||||
let compare_vals ~dir =
|
||||
List.compare ~compare:(compare_vals ~dir)
|
||||
|
||||
let concat ts ~dir =
|
||||
List.map ~f:(to_string ~dir) ts
|
||||
|> String.concat ~sep:" "
|
||||
|
|
|
@ -5,6 +5,8 @@ type t =
|
|||
| Dir of Path.t
|
||||
| Path of Path.t
|
||||
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
|
||||
val to_string : t -> dir:Path.t -> string
|
||||
|
||||
val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t
|
||||
|
@ -12,6 +14,16 @@ val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t
|
|||
module L : sig
|
||||
val strings : string list -> t list
|
||||
|
||||
(** [compare_vals ~dir a b] is a more efficient version of:
|
||||
|
||||
{[
|
||||
List.compare ~compare:String.compare
|
||||
(to_string ~dir a)
|
||||
(to_string ~dir b)
|
||||
]}
|
||||
*)
|
||||
val compare_vals : dir:Path.t -> t list -> t list -> Ordering.t
|
||||
|
||||
val paths : Path.t list -> t list
|
||||
|
||||
val deps_only : t list -> Path.t list
|
||||
|
|
Loading…
Reference in New Issue