X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=lib%2Fwhenutils.ml;h=aa59f1851fd92eed894304c2e001a90db5242a67;hp=d53ac7e852e0cdbe02bfcf2c353b81486de3a23d;hb=13e08143334d6e4fcda0bdbb1444dc0ba2af6b69;hpb=05ade7bb494f37bbbfb4b20d59d487e5ede98b05

diff --git a/lib/whenutils.ml b/lib/whenutils.ml
index d53ac7e..aa59f18 100644
--- a/lib/whenutils.ml
+++ b/lib/whenutils.ml
@@ -52,6 +52,7 @@ let rec filter_map f = function
     | None -> filter_map f xs
 
 type whenexpr =
+  | Expr_unit
   | Expr_bool of bool
   | Expr_str of string
   | Expr_int of Big_int.big_int
@@ -74,11 +75,13 @@ type whenexpr =
   | Expr_increases of string
   | Expr_decreases of string
   | Expr_prev of string
+  | Expr_reloaded
 
 (* This internal type is used during conversion of the OCaml AST
  * to the whenexpr type.
  *)
 type whenexpr_int =
+  | IExpr_unit
   | IExpr_bool of bool
   | IExpr_str of string
   | IExpr_int of Big_int.big_int
@@ -104,18 +107,21 @@ type shell_script = {
 }
 
 type variable =
+  | T_unit
   | T_bool of bool
   | T_string of string
   | T_int of big_int
   | T_float of float
 
 let variable_of_rpc = function
+  | `unit_t -> T_unit
   | `bool_t b -> T_bool b
   | `string_t s -> T_string s
   | `int_t i -> T_int (big_int_of_string i)
   | `float_t f -> T_float f
 
 let rpc_of_variable = function
+  | T_unit -> `unit_t
   | T_bool b -> `bool_t b
   | T_string s -> `string_t s
   | T_int i -> `int_t (string_of_big_int i)
@@ -127,18 +133,19 @@ type job_private = {
   (* The result of the previous evaluation.  This is used for
    * implementing edge-triggering, since we only trigger the job to run
    * when the state changes from false -> true.
+   *
+   * [None] means there has been no previous evaluation.
    *)
-  job_prev_eval_state : bool;
+  job_prev_eval_state : bool option;
 
   (* When the job {i ran} last time, we take a copy of the variables.
    * This allows us to implement the 'changes' operator.
+   *
+   * [None] means there has been no previous run.
    *)
-  job_prev_variables : variables;
+  job_prev_variables : variables option;
 }
 
-let no_job_private =
-  { job_prev_eval_state = false; job_prev_variables = StringMap.empty }
-
 type job_cond =
   | When_job of whenexpr
   | Every_job of periodexpr
@@ -151,10 +158,23 @@ type job = {
   job_private : job_private;
 }
 
+let make_when_job _loc name e sh =
+  { job_loc = _loc; job_name = name;
+    job_cond = When_job e; job_script = sh;
+    job_private = { job_prev_eval_state = None;
+                    job_prev_variables = None } }
+
+let make_every_job _loc name e sh =
+  { job_loc = _loc; job_name = name;
+    job_cond = Every_job e; job_script = sh;
+    job_private = { job_prev_eval_state = None;
+                    job_prev_variables = None } }
+
 let rec expr_of_ast _loc ast =
   expr_of_iexpr _loc (iexpr_of_ast _loc ast)
 
 and iexpr_of_ast _loc = function
+  | ExId (_, IdUid (_, "()")) -> IExpr_unit
   | ExId (_, IdUid (_, "True")) -> IExpr_bool true
   | ExId (_, IdUid (_, "False")) -> IExpr_bool false
   | ExStr (_, str) -> IExpr_str str
@@ -190,6 +210,7 @@ and uncurry_app_tree _loc = function
     invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc))
 
 and expr_of_iexpr _loc = function
+  | IExpr_unit -> Expr_unit
   | IExpr_bool b -> Expr_bool b
   | IExpr_str s -> Expr_str s
   | IExpr_int i -> Expr_int i
@@ -251,6 +272,12 @@ and expr_of_iexpr _loc = function
     invalid_arg (sprintf "%s: '%s' operator must be followed by a variable name"
                    (Loc.to_string _loc) op)
 
+  | IExpr_app ("reloaded", [IExpr_unit]) ->
+    Expr_reloaded
+
+  | IExpr_app ("reloaded", _) ->
+    invalid_arg (sprintf "%s: you must use 'reloaded ()'" (Loc.to_string _loc))
+
   | IExpr_app (op, _) ->
     invalid_arg (sprintf "%s: unknown operator in expression: %s"
                    (Loc.to_string _loc) op)
@@ -270,6 +297,7 @@ and one_param _loc op exprs f =
                    op (Loc.to_string _loc))
 
 let rec string_of_whenexpr = function
+  | Expr_unit -> "()"
   | Expr_bool b -> sprintf "%b" b
   | Expr_str s -> sprintf "%S" s
   | Expr_int i -> sprintf "%s" (string_of_big_int i)
@@ -304,6 +332,7 @@ let rec string_of_whenexpr = function
   | Expr_increases v -> sprintf "increases %s" v
   | Expr_decreases v -> sprintf "decreases %s" v
   | Expr_prev v -> sprintf "prev %s" v
+  | Expr_reloaded -> "reloaded ()"
 
 let string_of_periodexpr = function
   | Every_seconds 1 -> "1 second"
@@ -316,6 +345,7 @@ let string_of_periodexpr = function
   | Every_years i -> sprintf "%d years" i
 
 let rec dependencies_of_whenexpr = function
+  | Expr_unit -> []
   | Expr_bool _ -> []
   | Expr_str _ -> []
   | Expr_int _ -> []
@@ -340,103 +370,105 @@ let rec dependencies_of_whenexpr = function
   | Expr_increases v
   | Expr_decreases v
   | Expr_prev v -> [v]
+  | Expr_reloaded -> []
 
 let dependencies_of_job = function
   | { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr
   | { job_cond = Every_job _ } -> []
 
-let rec eval_whenexpr job variables = function
+let rec eval_whenexpr job variables onload = function
+  | Expr_unit -> T_unit
   | Expr_bool b -> T_bool b
   | Expr_str s -> T_string s
   | Expr_int i -> T_int i
   | Expr_float f -> T_float f
 
   | Expr_var v ->
-    (try StringMap.find v variables with Not_found -> T_string "")
+    get_variable variables v
 
   | Expr_and (e1, e2) ->
-    if eval_whenexpr_as_bool job variables e1 &&
-       eval_whenexpr_as_bool job variables e2 then
+    if eval_whenexpr_as_bool job variables onload e1 &&
+       eval_whenexpr_as_bool job variables onload e2 then
       T_bool true
     else
       T_bool false
 
   | Expr_or (e1, e2) ->
-    if eval_whenexpr_as_bool job variables e1 ||
-       eval_whenexpr_as_bool job variables e2 then
+    if eval_whenexpr_as_bool job variables onload e1 ||
+       eval_whenexpr_as_bool job variables onload e2 then
       T_bool true
     else
       T_bool false
 
   | Expr_lt (e1, e2) ->
-    let e1 = eval_whenexpr job variables e1
-    and e2 = eval_whenexpr job variables e2 in
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload e2 in
     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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload e2 in
     if compare_values e1 e2 > 0 then
       T_bool true
     else
       T_bool false
 
   | Expr_not e ->
-    if not (eval_whenexpr_as_bool job variables e) then
+    if not (eval_whenexpr_as_bool job variables onload e) then
       T_bool true
     else
       T_bool false
 
   | Expr_add (e1, e2) ->
-    let e1 = eval_whenexpr job variables e1
-    and e2 = eval_whenexpr job variables e2 in
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload 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
+    let e1 = eval_whenexpr job variables onload e1
+    and e2 = eval_whenexpr job variables onload e2 in
     mod_values e1 e2
 
   | Expr_changes v ->
@@ -448,34 +480,44 @@ let rec eval_whenexpr job variables = function
 
   | 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
+    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
+    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 ""
+    get_prev_variable job v
+
+  | Expr_reloaded ->
+    T_bool onload
 
 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
+  let prev_value = get_prev_variable job v in
+  let curr_value = get_variable variables v in
   prev_value, curr_value
 
+and get_variable variables v =
+  try StringMap.find v variables with Not_found -> T_string ""
+
+and get_prev_variable job v =
+  match job.job_private.job_prev_variables with
+  | None ->
+    (* Job has never run.  XXX Should do better here. *)
+    T_string ""
+  | Some prev_variables ->
+    get_variable prev_variables v
+
 (* 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
+and eval_whenexpr_as_bool job variables onload expr =
+  match eval_whenexpr job variables onload expr with
+  | T_unit -> false
   | T_bool r -> r
   | T_string s -> s <> ""
   | T_int i -> sign_big_int i <> 0
@@ -491,6 +533,7 @@ and compare_values value1 value2 =
   | T_string s1, T_string s2 -> compare s1 s2
   | T_int i1, T_int i2 -> compare_big_int i1 i2
   | T_float f1, T_float f2 -> compare f1 f2
+    (* XXX BUG: int should be promoted to float in mixed numeric comparison *)
   | _ ->
     let value1 = string_of_variable value1
     and value2 = string_of_variable value2 in
@@ -559,37 +602,41 @@ and mod_values value1 value2 =
          (printable_string_of_variable value2))
 
 and string_of_variable = function
+  | T_unit -> "" (* for string_of_variable, we don't want () here *)
   | 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_unit -> "()"
   | 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 =
+let job_evaluate job variables onload =
   match job with
   | { job_cond = Every_job _ } -> false, job
   | { job_cond = When_job whenexpr } ->
-    let state = eval_whenexpr_as_bool job variables whenexpr in
+    let state = eval_whenexpr_as_bool job variables onload whenexpr in
 
     (* Because jobs are edge-triggered, we're only interested in the
      * case where the evaluation state changes from false -> true.
      *)
     match job.job_private.job_prev_eval_state, state with
-    | false, false
-    | true, true
-    | true, false ->
-      let jobp = { job.job_private with job_prev_eval_state = state } in
+    | None, false
+    | Some false, false
+    | Some true, true
+    | Some true, false ->
+      let jobp = { job.job_private with job_prev_eval_state = Some state } in
       let job = { job with job_private = jobp } in
       false, job
 
-    | false, true ->
-      let jobp = { job_prev_eval_state = true;
-                   job_prev_variables = variables } in
+    | None, true
+    | Some false, true ->
+      let jobp = { job_prev_eval_state = Some true;
+                   job_prev_variables = Some variables } in
       let job = { job with job_private = jobp } in
       true, job