diff options
Diffstat (limited to 'abstract/transform.ml')
-rw-r--r-- | abstract/transform.ml | 79 |
1 files changed, 63 insertions, 16 deletions
diff --git a/abstract/transform.ml b/abstract/transform.ml index 1cbc27d..17fd064 100644 --- a/abstract/transform.ml +++ b/abstract/transform.ml @@ -208,17 +208,17 @@ let clock_scope_here (node, prefix, _) = let gen_clock td (node, prefix, _) active rst_exprs = let clock_scope = node^"/"^prefix in let clock_eq = - f_or - (f_and (reset_cond rst_exprs) - (f_and + let rst_code = + f_and (if not (td.rp.no_time_scope clock_scope) then BRel(AST_EQ, NIdent(clock_scope^"time"), NIntConst 0, false) else BConst true) (if td.rp.init_scope clock_scope then f_e_eq (EIdent(clock_scope^"init")) (EItem bool_true) - else BConst true))) - (f_and (no_reset_cond rst_exprs) - (if active then + else BConst true) + in + let no_rst_code = + if active then f_and (if not (td.rp.no_time_scope clock_scope) then BRel(AST_EQ, NIdent(clock_scope^"time"), @@ -238,7 +238,14 @@ let gen_clock td (node, prefix, _) active rst_exprs = (if td.rp.init_scope clock_scope then f_e_eq (EIdent(clock_scope^"init")) (EIdent ("L"^clock_scope^"init")) - else BConst true))) + else BConst true) + in + if rst_code = BConst true && no_rst_code = BConst true + then BConst true + else + f_or + (f_and (reset_cond rst_exprs) rst_code) + (f_and (no_reset_cond rst_exprs) no_rst_code) in (clock_scope, rst_exprs), clock_eq @@ -374,6 +381,13 @@ let rec f_of_scope active td (node, prefix, eqs) (clock_scope, rst_exprs as cs) (f_and (no_reset_cond rst_exprs) (f_e_eq (EIdent stv) (EIdent lnstv))) in + let rst_states = uniq_sorted @@ List.sort compare @@ List.flatten + (List.map (fun (st, _) -> + List.map (fun (_, (id, _), _) -> id) + (List.filter (fun (_, _, rst) -> rst) st.until)) + states) + in + let st_eq_inact (st, _) = let st_scope = node, aid^"."^st.st_name^".", st.body in let clock_scope, clock_eq = gen_clock td st_scope false rst_exprs in @@ -386,28 +400,61 @@ let rec f_of_scope active td (node, prefix, eqs) (clock_scope, rst_exprs as cs) let st_eq_act (st, l) = let act_eq = let st_scope = node, aid^"."^st.st_name^".", st.body in + let rst_exprs = + if List.mem st.st_name rst_states then + (f_e_eq (EIdent("L"^node^"/"^aid^"."^st.st_name^".must_reset")) + (EItem bool_true))::rst_exprs + else rst_exprs + in let cs2, clock_eq = gen_clock td st_scope true rst_exprs in let st_eq = f_and clock_eq (f_of_scope true td st_scope cs2 assume_guarantees) in + + let cr, cnr = List.partition + (fun i -> List.exists (fun (_, (v, _), x) -> x && v = i) st.until) + rst_states in + let must_reset_c l f = + f_and_list + (List.map + (fun i -> f_e_eq (EIdent (node^"/"^aid^"."^i^".must_reset")) + (EItem (if f i then bool_true else bool_false))) + l) + in let rec aux = function - | [] -> BEnumCons(E_EQ, nstv, EItem st.st_name) + | [] -> + f_and + (must_reset_c cr (fun _ -> false)) + (BEnumCons(E_EQ, nstv, EItem st.st_name)) | (c, (target, l), rst)::q -> - if rst then loc_error l error "Resetting transitions not supported."; f_or (f_and (f_of_expr td (node, prefix, clock_scope) c) - (BEnumCons(E_EQ, nstv, EItem target))) + (f_and + (BEnumCons(E_EQ, nstv, EItem target)) + (must_reset_c cr (fun i -> rst && i = target)))) (f_and (BNot (f_of_expr td (node, prefix, clock_scope) c)) (aux q)) - in f_and st_eq (aux st.until) + in + let trans_code = must_reset_c cnr (fun _ -> false) in + let trans_code = f_and trans_code (aux st.until) in + f_and st_eq trans_code in - f_or - (f_and (BEnumCons(E_EQ, stv, EItem st.st_name)) act_eq) - (f_and (BEnumCons(E_NE, stv, EItem st.st_name)) - (st_eq_inact (st, l))) + if List.length states = 1 then + act_eq + else + f_or + (f_and (BEnumCons(E_EQ, stv, EItem st.st_name)) act_eq) + (f_and (BEnumCons(E_NE, stv, EItem st.st_name)) + (st_eq_inact (st, l))) in f_and st_choice_eq (f_and_list (List.map st_eq_act states)) else f_and st_choice_eq - (f_and_list (List.map st_eq_inact states)) + (f_and + (f_and_list + (List.map + (fun s -> let n = node^"/"^aid^"."^s^".must_reset" in + f_e_eq (EIdent n) (EIdent ("L"^n))) + rst_states)) + (f_and_list (List.map st_eq_inact states))) in f_and_list (List.map do_eq eqs) |