X-Git-Url: http://git.annexia.org/?p=whenjobs.git;a=blobdiff_plain;f=lib%2Fwhenexpr.ml;h=8ccde2cedd7c1c56b456317faeea52c763c8bceb;hp=5b4bbdddd4382c46a9e6df866ad3b57e55600ad7;hb=5c7aa66dbdb32b4fc11d0f72a4cc028c7bfb1b55;hpb=76e68068f22a67c788f14a7c9404db7f7514da49 diff --git a/lib/whenexpr.ml b/lib/whenexpr.ml index 5b4bbdd..8ccde2c 100644 --- a/lib/whenexpr.ml +++ b/lib/whenexpr.ml @@ -47,6 +47,7 @@ type whenexpr = | 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 @@ -105,23 +106,6 @@ let rpc_of_variable = function 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 @@ -131,21 +115,8 @@ type job = { 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) @@ -232,6 +203,9 @@ and expr_of_iexpr _loc = function | 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 @@ -304,6 +278,7 @@ let rec string_of_whenexpr = function 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 @@ -340,7 +315,8 @@ let rec dependencies_of_whenexpr = function | 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 @@ -352,7 +328,7 @@ let dependencies_of_job = function | { 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 @@ -363,127 +339,132 @@ let rec eval_whenexpr job variables onload = function 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 "" @@ -491,8 +472,8 @@ and get_prev_variable job v = 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 <> "" @@ -591,31 +572,6 @@ and printable_string_of_variable = function | 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 =