From: Richard W.M. Jones Date: Tue, 21 Feb 2012 12:48:36 +0000 (+0000) Subject: Add new when-expression operators. X-Git-Tag: 0.0.1~18 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=fc824db2d9688b955ff5556483f45c783d27f804;p=whenjobs.git Add new when-expression operators. < <= > >= + - * / mod increases decreases prev --- diff --git a/daemon/daemon.ml b/daemon/daemon.ml index 3aee15a..eca0218 100644 --- a/daemon/daemon.ml +++ b/daemon/daemon.ml @@ -166,7 +166,13 @@ and reevaluate_whenjobs jobnames = with Not_found -> assert false in assert (jobname = job.job_name); - let r, job' = job_evaluate job !variables in + let r, job' = + try job_evaluate job !variables + with Invalid_argument err | Failure err -> + Syslog.error "error evaluating job %s (at %s): %s" + jobname (Camlp4.PreCast.Ast.Loc.to_string job.job_loc) err; + false, job in + jobs := StringMap.add jobname job' !jobs; if !debug then diff --git a/lib/whenutils.ml b/lib/whenutils.ml index ed1b065..9614ef8 100644 --- a/lib/whenutils.ml +++ b/lib/whenutils.ml @@ -56,9 +56,21 @@ type whenexpr = | Expr_var of string | Expr_and of whenexpr * whenexpr | Expr_or of whenexpr * whenexpr + | Expr_lt of whenexpr * whenexpr + | Expr_le of whenexpr * whenexpr | Expr_eq of whenexpr * whenexpr + | Expr_ge of whenexpr * whenexpr + | Expr_gt of whenexpr * whenexpr | Expr_not of whenexpr + | Expr_add of whenexpr * whenexpr + | Expr_sub of whenexpr * whenexpr + | Expr_mul of whenexpr * whenexpr + | Expr_div of whenexpr * whenexpr + | Expr_mod of whenexpr * whenexpr | Expr_changes of string + | Expr_increases of string + | Expr_decreases of string + | Expr_prev of string (* This internal type is used during conversion of the OCaml AST * to the whenexpr type. @@ -182,48 +194,78 @@ and expr_of_iexpr _loc = function | IExpr_var v -> Expr_var v | IExpr_app ("&&", exprs) -> - (match exprs with - | [e1; e2] -> Expr_and (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) - | _ -> - invalid_arg (sprintf "%s: && operator must be applied to two parameters" - (Loc.to_string _loc)) - ) + two_params _loc "&&" exprs (fun e1 e2 -> Expr_and (e1, e2)) | IExpr_app ("||", exprs) -> - (match exprs with - | [e1; e2] -> Expr_or (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) - | _ -> - invalid_arg (sprintf "%s: || operator must be applied to two parameters" - (Loc.to_string _loc)) - ) + two_params _loc "||" exprs (fun e1 e2 -> Expr_or (e1, e2)) + + | IExpr_app ("<", exprs) -> + two_params _loc "<" exprs (fun e1 e2 -> Expr_lt (e1, e2)) + + | IExpr_app ("<=", exprs) -> + two_params _loc "<=" exprs (fun e1 e2 -> Expr_le (e1, e2)) | IExpr_app (("="|"=="), exprs) -> - (match exprs with - | [e1; e2] -> Expr_eq (expr_of_iexpr _loc e1, expr_of_iexpr _loc e2) - | _ -> - invalid_arg (sprintf "%s: = operator must be applied to two parameters" - (Loc.to_string _loc)) - ) + two_params _loc "=" exprs (fun e1 e2 -> Expr_eq (e1, e2)) + + | IExpr_app (">=", exprs) -> + two_params _loc ">=" exprs (fun e1 e2 -> Expr_ge (e1, e2)) + + | IExpr_app (">", exprs) -> + two_params _loc ">" exprs (fun e1 e2 -> Expr_gt (e1, e2)) | IExpr_app ("!", exprs) -> - (match exprs with - | [e1] -> Expr_not (expr_of_iexpr _loc e1) - | _ -> - invalid_arg (sprintf "%s: ! operator must be applied to one parameter" - (Loc.to_string _loc)) - ) + one_param _loc "!" exprs (fun e1 -> Expr_not e1) + + | IExpr_app ("+", exprs) -> + two_params _loc "+" exprs (fun e1 e2 -> Expr_add (e1, e2)) + + | IExpr_app ("-", exprs) -> + two_params _loc "+" exprs (fun e1 e2 -> Expr_sub (e1, e2)) + + | IExpr_app ("*", exprs) -> + two_params _loc "+" exprs (fun e1 e2 -> Expr_mul (e1, e2)) + + | IExpr_app ("/", exprs) -> + two_params _loc "+" exprs (fun e1 e2 -> Expr_div (e1, e2)) + + | IExpr_app ("mod", exprs) -> + two_params _loc "+" exprs (fun e1 e2 -> Expr_mod (e1, e2)) | IExpr_app (("change"|"changes"|"changed"), [IExpr_var v]) -> Expr_changes v - | IExpr_app (("change"|"changes"|"changed"), _) -> - invalid_arg (sprintf "%s: 'changes' operator must be followed by a variable name" - (Loc.to_string _loc)) + | IExpr_app (("inc"|"increase"|"increases"|"increased"), [IExpr_var v]) -> + Expr_increases v + + | IExpr_app (("dec"|"decrease"|"decreases"|"decreased"), [IExpr_var v]) -> + Expr_decreases v + + | IExpr_app (("prev"|"previous"), [IExpr_var v]) -> + Expr_prev v + + | IExpr_app (("change"|"changes"|"changed"|"inc"|"increase"|"increases"|"increased"|"dec"|"decrease"|"decreases"|"decreased"|"prev"|"previous") as op, _) -> + invalid_arg (sprintf "%s: '%s' operator must be followed by a variable name" + op (Loc.to_string _loc)) | IExpr_app (op, _) -> invalid_arg (sprintf "%s: unknown operator in expression: %s" (Loc.to_string _loc) op) +and two_params _loc op exprs f = + match exprs with + | [e1; e2] -> f (expr_of_iexpr _loc e1) (expr_of_iexpr _loc e2) + | _ -> + invalid_arg (sprintf "%s: %s operator must be applied to two parameters" + op (Loc.to_string _loc)) + +and one_param _loc op exprs f = + match exprs with + | [e1] -> f (expr_of_iexpr _loc e1) + | _ -> + invalid_arg (sprintf "%s: %s operator must be applied to one parameter" + op (Loc.to_string _loc)) + let rec string_of_whenexpr = function | Expr_bool b -> sprintf "%b" b | Expr_str s -> sprintf "%S" s @@ -234,10 +276,31 @@ let rec string_of_whenexpr = function sprintf "%s && %s" (string_of_whenexpr e1) (string_of_whenexpr e2) | Expr_or (e1, e2) -> sprintf "%s || %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_lt (e1, e2) -> + sprintf "%s < %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_le (e1, e2) -> + sprintf "%s <= %s" (string_of_whenexpr e1) (string_of_whenexpr e2) | Expr_eq (e1, e2) -> sprintf "%s == %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_ge (e1, e2) -> + sprintf "%s >= %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_gt (e1, e2) -> + sprintf "%s > %s" (string_of_whenexpr e1) (string_of_whenexpr e2) | Expr_not e -> sprintf "! %s" (string_of_whenexpr e) + | Expr_add (e1, e2) -> + sprintf "%s + %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_sub (e1, e2) -> + sprintf "%s - %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_mul (e1, e2) -> + sprintf "%s * %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_div (e1, e2) -> + sprintf "%s / %s" (string_of_whenexpr e1) (string_of_whenexpr e2) + | Expr_mod (e1, e2) -> + sprintf "%s mod %s" (string_of_whenexpr e1) (string_of_whenexpr e2) | Expr_changes v -> sprintf "changes %s" v + | Expr_increases v -> sprintf "increases %s" v + | Expr_decreases v -> sprintf "decreases %s" v + | Expr_prev v -> sprintf "prev %s" v let string_of_periodexpr = function | Every_seconds 1 -> "1 second" @@ -255,14 +318,25 @@ let rec dependencies_of_whenexpr = function | Expr_int _ -> [] | Expr_float _ -> [] | Expr_var v -> [v] - | Expr_and (e1, e2) -> + | Expr_and (e1, e2) + | Expr_or (e1, e2) + | Expr_lt (e1, e2) + | Expr_le (e1, e2) + | Expr_eq (e1, e2) + | Expr_ge (e1, e2) + | Expr_gt (e1, e2) + | Expr_add (e1, e2) + | Expr_sub (e1, e2) + | Expr_mul (e1, e2) + | Expr_div (e1, e2) + | Expr_mod (e1, e2) -> dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 - | Expr_or (e1, e2) -> - dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 - | Expr_eq (e1, e2) -> - dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2 - | Expr_not e -> dependencies_of_whenexpr e - | Expr_changes v -> [v] + | Expr_not e -> + dependencies_of_whenexpr e + | Expr_changes v + | Expr_increases v + | Expr_decreases v + | Expr_prev v -> [v] let dependencies_of_job = function | { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr @@ -291,10 +365,42 @@ let rec eval_whenexpr job variables = function else T_bool false + | Expr_lt (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + if compare_values e1 e2 < 0 then + T_bool true + else + T_bool false + + | Expr_le (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + if compare_values e1 e2 <= 0 then + T_bool true + else + T_bool false + | Expr_eq (e1, e2) -> let e1 = eval_whenexpr job variables e1 and e2 = eval_whenexpr job variables e2 in - if 0 = compare_values e1 e2 then + if compare_values e1 e2 = 0 then + T_bool true + else + T_bool false + + | Expr_ge (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + if compare_values e1 e2 >= 0 then + T_bool true + else + T_bool false + + | Expr_gt (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + if compare_values e1 e2 > 0 then T_bool true else T_bool false @@ -305,19 +411,65 @@ let rec eval_whenexpr job variables = function else T_bool false + | Expr_add (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + add_values e1 e2 + + | Expr_sub (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + sub_values e1 e2 + + | Expr_mul (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + mul_values e1 e2 + + | Expr_div (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + div_values e1 e2 + + | Expr_mod (e1, e2) -> + let e1 = eval_whenexpr job variables e1 + and e2 = eval_whenexpr job variables e2 in + mod_values e1 e2 + | Expr_changes v -> - let prev_value = - try StringMap.find v job.job_private.job_prev_variables - with Not_found -> T_string "" in - let curr_value = - try StringMap.find v variables - with Not_found -> T_string "" in - - if 0 <> compare_values prev_value curr_value then + let prev_value, curr_value = get_prev_curr_value job variables v in + if compare_values prev_value curr_value <> 0 then T_bool true else T_bool false + | Expr_increases v -> + let prev_value, curr_value = get_prev_curr_value job variables v in + if compare_values prev_value curr_value > 0 then + T_bool true + else + T_bool false + + | Expr_decreases v -> + let prev_value, curr_value = get_prev_curr_value job variables v in + if compare_values prev_value curr_value < 0 then + T_bool true + else + T_bool false + + | Expr_prev v -> + try StringMap.find v job.job_private.job_prev_variables + with Not_found -> T_string "" + +and get_prev_curr_value job variables v = + let prev_value = + try StringMap.find v job.job_private.job_prev_variables + with Not_found -> T_string "" in + let curr_value = + try StringMap.find v variables + with Not_found -> T_string "" in + prev_value, curr_value + (* Call {!eval_whenexpr} and cast the result to a boolean. *) and eval_whenexpr_as_bool job variables expr = match eval_whenexpr job variables expr with @@ -341,12 +493,80 @@ and compare_values value1 value2 = and value2 = string_of_variable value2 in compare value1 value2 +(* + operator is addition or string concatenation. *) +and add_values value1 value2 = + match value1, value2 with + | T_int i1, T_int i2 -> T_int (add_big_int i1 i2) + | T_float i1, T_float i2 -> T_float (i1 +. i2) + | T_int i1, T_float i2 -> T_float (float_of_big_int i1 +. i2) + | T_float i1, T_int i2 -> T_float (i1 +. float_of_big_int i2) + | T_string i1, T_string i2 -> T_string (i1 ^ i2) + | _ -> + invalid_arg + (sprintf "incompatible types in addition: %s + %s" + (printable_string_of_variable value1) + (printable_string_of_variable value2)) + +and sub_values value1 value2 = + match value1, value2 with + | T_int i1, T_int i2 -> T_int (sub_big_int i1 i2) + | T_float i1, T_float i2 -> T_float (i1 -. i2) + | T_int i1, T_float i2 -> T_float (float_of_big_int i1 -. i2) + | T_float i1, T_int i2 -> T_float (i1 -. float_of_big_int i2) + | _ -> + invalid_arg + (sprintf "incompatible types in subtraction: %s - %s" + (printable_string_of_variable value1) + (printable_string_of_variable value2)) + +and mul_values value1 value2 = + match value1, value2 with + | T_int i1, T_int i2 -> T_int (mult_big_int i1 i2) + | T_float i1, T_float i2 -> T_float (i1 *. i2) + | T_int i1, T_float i2 -> T_float (float_of_big_int i1 *. i2) + | T_float i1, T_int i2 -> T_float (i1 *. float_of_big_int i2) + | _ -> + invalid_arg + (sprintf "incompatible types in multiplication: %s * %s" + (printable_string_of_variable value1) + (printable_string_of_variable value2)) + +and div_values value1 value2 = + match value1, value2 with + | T_int i1, T_int i2 -> T_int (div_big_int i1 i2) + | T_float i1, T_float i2 -> T_float (i1 /. i2) + | T_int i1, T_float i2 -> T_float (float_of_big_int i1 /. i2) + | T_float i1, T_int i2 -> T_float (i1 /. float_of_big_int i2) + | _ -> + invalid_arg + (sprintf "incompatible types in division: %s / %s" + (printable_string_of_variable value1) + (printable_string_of_variable value2)) + +and mod_values value1 value2 = + match value1, value2 with + | T_int i1, T_int i2 -> T_int (mod_big_int i1 i2) + | T_float i1, T_float i2 -> T_float (mod_float i1 i2) + | T_int i1, T_float i2 -> T_float (mod_float (float_of_big_int i1) i2) + | T_float i1, T_int i2 -> T_float (mod_float i1 (float_of_big_int i2)) + | _ -> + invalid_arg + (sprintf "incompatible types in modulo: %s mod %s" + (printable_string_of_variable value1) + (printable_string_of_variable value2)) + and string_of_variable = function | T_bool b -> string_of_bool b | T_string s -> s | T_int i -> string_of_big_int i | T_float f -> string_of_float f +and printable_string_of_variable = function + | T_bool b -> string_of_bool b + | T_string s -> sprintf "%S" s + | T_int i -> string_of_big_int i + | T_float f -> string_of_float f + let job_evaluate job variables = match job with | { job_cond = Every_job _ } -> false, job diff --git a/lib/whenutils.mli b/lib/whenutils.mli index 1572d02..f0fb306 100644 --- a/lib/whenutils.mli +++ b/lib/whenutils.mli @@ -128,9 +128,21 @@ type whenexpr = | Expr_var of string (** A variable name. *) | Expr_and of whenexpr * whenexpr (** && *) | Expr_or of whenexpr * whenexpr (** || *) + | Expr_lt of whenexpr * whenexpr (** < *) + | Expr_le of whenexpr * whenexpr (** <= *) | Expr_eq of whenexpr * whenexpr (** == *) - | Expr_not of whenexpr (** ! *) + | Expr_ge of whenexpr * whenexpr (** >= *) + | Expr_gt of whenexpr * whenexpr (** > *) + | Expr_not of whenexpr (** boolean not *) + | Expr_add of whenexpr * whenexpr (** arithmetic addition or string cat *) + | Expr_sub of whenexpr * whenexpr (** arithmetic subtraction *) + | Expr_mul of whenexpr * whenexpr (** arithmetic multiplication *) + | Expr_div of whenexpr * whenexpr (** arithmetic division *) + | Expr_mod of whenexpr * whenexpr (** arithmetic modulo *) | Expr_changes of string (** changes var *) + | Expr_increases of string (** increases var *) + | Expr_decreases of string (** decreases var *) + | Expr_prev of string (** prev var *) (** Internal type used to represent 'when' expressions. *) type periodexpr =