Add new when-expression operators.

< <= > >=
+ - * / mod
increases decreases
prev

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 3aee15a..eca0218 100644 (file)
--- 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);
 
             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
           jobs := StringMap.add jobname job' !jobs;
 
           if !debug then

diff --git a/lib/whenutils.ml b/lib/whenutils.ml
index ed1b065..9614ef8 100644 (file)
--- 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_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_eq of whenexpr * whenexpr

+  | Expr_ge of whenexpr * whenexpr
+  | Expr_gt of whenexpr * whenexpr

   | Expr_not of 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_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.
 
 (* 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) ->
   | 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) ->
 
   | 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) ->
 
   | 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) ->
 
   | 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"), [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)
 
 
   | 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
 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)
     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_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_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_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"
 
 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_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
     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
 
 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
 
     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
   | 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
       T_bool true
     else
       T_bool false


@@ -305,19 +411,65 @@ let rec eval_whenexpr job variables = function
     else
       T_bool false
 
     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 ->
   | 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
 
       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
 (* 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
 
     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 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
 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 (file)
--- 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_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_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_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 =
 (** Internal type used to represent 'when' expressions. *)
 
 type periodexpr =