let rec type_seq default_state tr env needs_pebble curr_start curr_end seq =
let add_if_needed states st =
if List.for_all (fun x -> x.nums <> st.nums) states
then st::states else states
in
match seq with
| [] ->
(env, [], [], curr_end, curr_end)
| elt :: seq ->
let is_single_trans =
match elt.min_rep, elt.max_rep with
| Some min, Some max -> is_cst_one min && is_cst_one max
| None, _ | _, None -> false
in
let is_opt =
match elt.min_rep with
| Some min -> is_cst_zero min
| None-> true
in
let might_be_zero =
is_opt ||
(match Extlib.the elt.min_rep with PCst _ -> false | _ -> true)
in
let at_most_one =
is_opt &&
match elt.max_rep with
| None -> false
| Some max -> is_cst_one max
in
let has_loop = not at_most_one && not is_single_trans in
let needs_counter =
match elt.min_rep, elt.max_rep with
| None, None -> false
| Some min, None -> not (is_cst_zero min || is_cst_one min)
| None, Some max -> not (is_cst_one max)
| Some min, Some max ->
not (is_cst_zero min || is_cst_one min) || not (is_cst_one max)
in
let fixed_number_of_loop =
match elt.min_rep, elt.max_rep with
| _, None -> false
| None, Some max -> not (is_cst_zero max)
| Some min, Some max -> is_same_expression min max
in
let my_end =
match seq with
[] when not (curr_end.nums = tr.stop.nums)
|| is_single_trans || at_most_one -> curr_end
| _ -> new_intermediate_state ()
in
Aorai_option.debug "Examining single elt:@\n%s -> %s:@[%a@]"
curr_start.name my_end.name Promelaoutput.print_seq_elt elt;
let guard_exit_loop env current counter =
if is_opt then TTrue
else
let e = Extlib.the elt.min_rep in
let _,e,_ = type_expr env ?current e in
TRel(Cil_types.Rle,e,counter)
in
let guard_loop env current counter =
match elt.max_rep with
| None -> TTrue
| Some e ->
let _,e,_ = type_expr env ?current e in
Max_value_counter.replace counter e;
TRel(Cil_types.Rlt, counter, e)
in
let env,inner_states, inner_trans, inner_start, inner_end =
match elt.condition with
| None ->
assert (elt.nested <> []);
type_seq
default_state tr env needs_pebble curr_start my_end elt.nested
| Some cond ->
let seq_start =
match elt.nested with
[] -> my_end
| _ -> new_intermediate_state ()
in
let trans_start = new_trans curr_start seq_start (Normal (TTrue,[]))
in
let inner_env, cond = type_cond needs_pebble env trans_start cond in
let (env,states, seq_transitions, seq_end) =
match elt.nested with
| [] -> inner_env, [], [], my_end
| _ ->
let intermediate = new_intermediate_state () in
let (env, states, transitions, _, seq_end) =
type_seq
default_state tr
inner_env needs_pebble seq_start intermediate elt.nested
in env, states, transitions, seq_end
in
let states = add_if_needed states curr_start in
let transitions = trans_start :: seq_transitions in
(match trans_start.cross with
| Normal (conds,action) ->
trans_start.cross <- Normal(tand cond conds,action)
| Epsilon _ ->
Aorai_option.fatal
"Transition guard translated as epsilon transition");
let states = add_if_needed states seq_start in
(match env with
| [] | (ENone | ECall _) :: _ ->
(env, states, transitions, curr_start, seq_end)
| EReturn kf1 :: ECall (kf2,_,_) :: tl
when Kernel_function.equal kf1 kf2 ->
(tl, states, transitions, curr_start, seq_end)
| (EReturn _ | ECOR _ ) :: _ ->
(env, states, transitions, curr_start, seq_end)
| EMulti :: env ->
(env, states, transitions, curr_start, seq_end))
in
let loop_end = if has_loop then new_intermediate_state () else inner_end
in
let (_,oth_states,oth_trans,oth_start,_) =
type_seq default_state tr env needs_pebble loop_end curr_end seq
in
let trans = inner_trans @ oth_trans in
let states = List.fold_left add_if_needed oth_states inner_states in
let auto = (inner_states,inner_trans) in
if at_most_one then begin
let opt = new_trans curr_start oth_start (Epsilon (TTrue,[])) in
env, states, opt::trans, curr_start, curr_end
end
else if has_loop then begin
let counter =
let ty = if needs_pebble then
Cil_types.TArray (Cil.intType,None,{scache=Not_Computed},[])
else Cil.intType
in
lazy (
let vi = Cil.makeGlobalVar (get_fresh "aorai_counter") ty in
add_aux_variable vi;
vi
)
in
let make_counter st =
let vi = Lazy.force counter in
let base = TVar (Cil.cvar_to_lvar vi), TNoOffset in
if needs_pebble then
let (_,idx) = memo_multi_state st in
Cil.addTermOffsetLval
(TIndex (Logic_const.tvar idx,TNoOffset)) base
else base
in
let make_counter_term st =
Logic_const.term (TLval (make_counter st)) (Ctype Cil.intType)
in
Aorai_option.debug "Inner start is %s; Inner end is %s"
inner_start.name inner_end.name;
let treat_state (states, oth_trans) st =
let trans = Path_analysis.get_transitions_of_state st auto in
if st.nums = inner_start.nums then begin
let loop_trans =
if needs_counter then begin
List.fold_left
(fun acc tr ->
let init_action = Counter_init (make_counter tr.stop) in
let init_cross =
match tr.cross with
| Normal (cond, actions) ->
Normal(cond, init_action :: actions)
| Epsilon(cond, actions) ->
Epsilon(cond, init_action :: actions)
in
Aorai_option.debug "New init trans %s -> %s: %a"
st.name tr.stop.name
print_epsilon_trans init_cross;
let init_trans =
new_trans st tr.stop init_cross
in
if at_most_one then init_trans :: acc
else begin
let st =
if needs_pebble then Some curr_start else None
in
let loop_cond =
if needs_counter then
guard_loop env st
(make_counter_term curr_start)
else TTrue
in
let loop_action =
if needs_counter then begin
let counter = make_counter curr_start in
[ Counter_incr counter ]
end else []
in
let loop_cross =
match tr.cross with
| Normal(cond, actions) ->
Normal(tand loop_cond cond, loop_action @ actions)
| Epsilon(cond, actions) ->
Epsilon(tand loop_cond cond, loop_action @ actions)
in
Aorai_option.debug "New loop trans %s -> %s: %a"
inner_end.name tr.stop.name
print_epsilon_trans loop_cross;
let loop_trans =
new_trans inner_end tr.stop loop_cross in
init_trans :: loop_trans :: acc
end)
oth_trans trans
end else oth_trans
in
let trans =
if might_be_zero then begin
let zero_cond =
if is_opt then TTrue
else
let current =
if needs_pebble then Some curr_start else None
in
let _,t,_ =
type_expr env ?current (Extlib.the elt.min_rep)
in
TRel (Cil_types.Req, t, Logic_const.tinteger ~ikind:IInt 0)
in
let no_seq = new_trans st oth_start (Epsilon (zero_cond,[])) in
no_seq :: loop_trans
end else loop_trans
in
states, trans
end
else if st.nums = inner_end.nums then begin
let st =
if needs_pebble then Some curr_end else None
in
let min_cond =
if needs_counter then
guard_exit_loop env st (make_counter_term curr_end)
else TTrue
in
let min_cond = Epsilon (min_cond,[]) in
Aorai_option.debug "New exit trans %s -> %s: %a"
inner_end.name oth_start.name
print_epsilon_trans min_cond;
let exit_trans = new_trans inner_end oth_start min_cond in
let trans = exit_trans :: trans @ oth_trans in
states, trans
end else begin
if fixed_number_of_loop || default_state then
states, trans @ oth_trans
else begin
let cond =
List.fold_left
(fun acc tr ->
match tr.cross with
| Normal (cond,_) | Epsilon (cond,_) ->
let cond = change_bound_var tr.stop st cond in
tor acc cond)
TFalse trans
in
let (cond,_) = Logic_simplification.simplifyCond cond in
let cond = tnot cond in
(match cond with
TFalse -> states, trans @ oth_trans
| _ ->
let reject = get_reject_state () in
let states = add_if_needed states reject in
let trans = new_trans st reject (Normal(cond,[])) :: trans
in states, trans @ oth_trans
)
end
end
in
let states, trans =
List.fold_left treat_state
(states, oth_trans)
inner_states
in
env, states, trans, curr_start, curr_end
end else
env, states, trans, curr_start, curr_end