| Expr_mul of whenexpr * whenexpr
| Expr_div of whenexpr * whenexpr
| Expr_mod of whenexpr * whenexpr
+ | Expr_len of whenexpr
| Expr_changes of string
| Expr_increases of string
| Expr_decreases of string
type variables = variable StringMap.t
-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 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 option;
-}
-
type job_cond =
| When_job of whenexpr
| Every_job of periodexpr
job_name : string;
job_cond : job_cond;
job_script : shell_script;
- 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)
| IExpr_app ("mod", exprs) ->
two_params _loc "+" exprs (fun e1 e2 -> Expr_mod (e1, e2))
+ | IExpr_app (("len"|"length"|"size"), exprs) ->
+ one_param _loc "len" exprs (fun e1 -> Expr_len e1)
+
| IExpr_app (("change"|"changes"|"changed"), [IExpr_var v]) ->
Expr_changes v
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_len e -> sprintf "len %s" (string_of_whenexpr e)
| Expr_changes v -> sprintf "changes %s" v
| Expr_increases v -> sprintf "increases %s" v
| Expr_decreases v -> sprintf "decreases %s" v
| Expr_div (e1, e2)
| Expr_mod (e1, e2) ->
dependencies_of_whenexpr e1 @ dependencies_of_whenexpr e2
- | Expr_not e ->
+ | Expr_not e
+ | Expr_len e ->
dependencies_of_whenexpr e
| Expr_changes v
| Expr_increases v
| { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr
| { job_cond = Every_job _ } -> []
-let rec eval_whenexpr job variables onload = function
+let rec eval_whenexpr variables prev_variables onload = function
| Expr_unit -> T_unit
| Expr_bool b -> T_bool b
| Expr_str s -> T_string s
get_variable variables v
| Expr_and (e1, e2) ->
- if eval_whenexpr_as_bool job variables onload e1 &&
- eval_whenexpr_as_bool job variables onload e2 then
+ if eval_whenexpr_as_bool variables prev_variables onload e1 &&
+ eval_whenexpr_as_bool variables prev_variables onload e2 then
T_bool true
else
T_bool false
| Expr_or (e1, e2) ->
- if eval_whenexpr_as_bool job variables onload e1 ||
- eval_whenexpr_as_bool job variables onload e2 then
+ if eval_whenexpr_as_bool variables prev_variables onload e1 ||
+ eval_whenexpr_as_bool variables prev_variables onload e2 then
T_bool true
else
T_bool false
| Expr_lt (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_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 onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_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 onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_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 onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_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 onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_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 onload e) then
+ if not (eval_whenexpr_as_bool variables prev_variables onload e) then
T_bool true
else
T_bool false
| Expr_add (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_variables onload e2 in
add_values e1 e2
| Expr_sub (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_variables onload e2 in
sub_values e1 e2
| Expr_mul (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_variables onload e2 in
mul_values e1 e2
| Expr_div (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_variables onload e2 in
div_values e1 e2
| Expr_mod (e1, e2) ->
- let e1 = eval_whenexpr job variables onload e1
- and e2 = eval_whenexpr job variables onload e2 in
+ let e1 = eval_whenexpr variables prev_variables onload e1
+ and e2 = eval_whenexpr variables prev_variables onload e2 in
mod_values e1 e2
+ | Expr_len e ->
+ let e = eval_whenexpr variables prev_variables onload e in
+ let e = string_of_variable e in
+ T_int (big_int_of_int (String.length e))
+
| Expr_changes v ->
- let prev_value, curr_value = get_prev_curr_value job variables v in
+ let prev_value, curr_value = get_prev_curr_value variables prev_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
+ let prev_value, curr_value = get_prev_curr_value variables prev_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
+ let prev_value, curr_value = get_prev_curr_value variables prev_variables v in
if compare_values prev_value curr_value > 0 then
T_bool true
else
T_bool false
| Expr_prev v ->
- get_prev_variable job v
+ get_prev_variable prev_variables v
| Expr_reloaded ->
T_bool onload
-and get_prev_curr_value job variables v =
- let prev_value = get_prev_variable job v in
+and get_prev_curr_value variables prev_variables v =
+ let prev_value = get_prev_variable prev_variables 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
+and get_prev_variable prev_variables v =
+ match prev_variables with
| None ->
(* Job has never run. XXX Should do better here. *)
T_string ""
get_variable prev_variables v
(* Call {!eval_whenexpr} and cast the result to a boolean. *)
-and eval_whenexpr_as_bool job variables onload expr =
- match eval_whenexpr job variables onload expr with
+and eval_whenexpr_as_bool variables prev_variables onload expr =
+ match eval_whenexpr variables prev_variables onload expr with
| T_unit -> false
| T_bool r -> r
| T_string s -> s <> ""
| T_int i -> string_of_big_int i
| T_float f -> string_of_float f
-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 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
- | 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
-
- | 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
-
let next_periodexpr =
(* Round up 'a' to the next multiple of 'i'. *)
let round_up_float a i =