(**************************************************************************)
(*                                                                        *)
(*  This file is part of Aorai plug-in of Frama-C.                        *)
(*                                                                        *)
(*  Copyright (C) 2007-2020                                               *)
(*    CEA (Commissariat à l'énergie atomique et aux énergies              *)
(*         alternatives)                                                  *)
(*    INRIA (Institut National de Recherche en Informatique et en         *)
(*           Automatique)                                                 *)
(*    INSA  (Institut National des Sciences Appliquees)                   *)
(*                                                                        *)
(*  you can redistribute it and/or modify it under the terms of the GNU   *)
(*  Lesser General Public License as published by the Free Software       *)
(*  Foundation, version 2.1.                                              *)
(*                                                                        *)
(*  It is distributed in the hope that it will be useful,                 *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU Lesser General Public License for more details.                   *)
(*                                                                        *)
(*  See the GNU Lesser General Public License version 2.1                 *)
(*  for more details (enclosed in the file licenses/LGPLv2.1).            *)
(*                                                                        *)
(**************************************************************************)

open Promelaast
open Extlib
open Logic_const
open Cil_types
open Cil
(**************************************************************************)

let dkey = Aorai_option.register_category "action"

let get_acceptance_pred () =
  let (st,_) = Data_for_aorai.getGraph () in
  List.fold_left
    (fun acc s ->
       match s.acceptation with
         Bool3.True -> Logic_const.por (acc, Aorai_utils.is_state_pred s)
       | Bool3.False | Bool3.Undefined -> acc)
    Logic_const.pfalse st

let get_call_name exp = match exp.enode with
  | Const(CStr(s)) -> s
  | Lval(Var(vi),NoOffset) -> vi.vname
  | _ ->
    Aorai_option.not_yet_implemented
      "At this time, only explicit calls are allowed by the Aorai plugin."

(****************************************************************************)

(* The instrumentation is done in two passes:
   1) creating auxiliary functions for each non-ignored C function, that update
   automaton's state when entering and exiting the function
   2) generating specifications for all the functions.

   We maintain tables from aux to orig so that the second visitor knows which
   is which. Note that this tables are cleared after each visit, and thus need
   not be projectified.
*)

(* the various kinds of auxiliary functions. *)
type func_auto_mode =
  | Not_auto_func (* original C function. *)
  | Aux_func of kernel_function
  (* Checks whether we are in the corresponding behavior of the function. *)
  | Pre_func of kernel_function
  (* Pre_func f denotes a function updating the automaton when f is called. *)
  | Post_func of kernel_function
  (* Post_func f denotes a function updating the automaton
     when returning from f. *)

(* table from auxiliary functions to the corresponding original one. *)
let func_orig_table = Cil_datatype.Varinfo.Hashtbl.create 17

let add_aux_bhv orig_kf vi =
  Cil_datatype.Varinfo.Hashtbl.add func_orig_table vi (Aux_func orig_kf)

let kind_of_func vi =
  try Cil_datatype.Varinfo.Hashtbl.find func_orig_table vi
  with Not_found -> Not_auto_func

(* The following functions will be used to generate C code for pre & post
   functions. *)

let mk_auto_fct_block kf_aux kf status auto_state res =
  let loc = Kernel_function.get_location kf in
  Aorai_utils.auto_func_block kf_aux loc kf status auto_state res

let mk_pre_fct_block kf_pre kf =
  mk_auto_fct_block
    kf_pre
    kf
    Promelaast.Call
    (Data_for_aorai.get_kf_init_state kf)
    None

let mk_post_fct_block kf_post kf res =
  mk_auto_fct_block
    kf_post
    kf
    Promelaast.Return
    (Data_for_aorai.get_kf_return_state kf)
    res

(**
   This visitor adds an auxiliary function for each C function which takes
   care of setting the automaton in a correct state before calling the
   original one, and replaces each occurrence of the original function by
   the auxiliary one. It also takes care of changing the automaton at function's
   return.
*)
class visit_adding_code_for_synchronisation =
  object (self)
    inherit Visitor.frama_c_inplace

    val aux_post_table = Kernel_function.Hashtbl.create 17

    method! vglob_aux g =
      match g with
      | GFun (fundec,loc) ->
        let kf = Extlib.the self#current_kf in
        let vi = Kernel_function.get_vi kf in
        let vi_pre = Cil_const.copy_with_new_vid vi in
        vi_pre.vname <- Data_for_aorai.get_fresh (vi_pre.vname ^ "_pre_func");
        vi_pre.vdefined <- true;
        vi_pre.vghost <- true;
        Cil_datatype.Varinfo.Hashtbl.add func_orig_table vi_pre (Pre_func kf);
        (* TODO:
           - what about protos that have no specified args
             (NB: cannot be identified here because of implem of Kernel_function).
           - what about varargs?
        *)
        let (rettype,args,varargs,_) = Cil.splitFunctionTypeVI vi_pre in
        Cil.update_var_type vi_pre (TFun(Cil.voidType, args, varargs,[]));
        vi_pre.vattr <- [];

        (* in particular get rid of __no_return if set in vi*)

        let arg =
          if Cil.isVoidType rettype
          then []
          else ["res",rettype,[]]
        in
        let vi_post =
          Cil.makeGlobalVar ~ghost:true
            (Data_for_aorai.get_fresh (vi.vname ^ "_post_func"))
            (TFun(voidType,Some arg,false,[]))
        in
        Kernel_function.Hashtbl.add aux_post_table kf vi_post;
        Cil_datatype.Varinfo.Hashtbl.add func_orig_table vi_post (Post_func kf);
        let fun_dec_pre = Cil.emptyFunctionFromVI vi_pre in
        let fun_dec_post = Cil.emptyFunctionFromVI vi_post in
        (* For a future analysis of function arguments,
           we have to update the function's formals. Search
           for LBLsformals. *)
        Cil.setFunctionTypeMakeFormals
          fun_dec_pre (TFun(Cil.voidType, args, varargs,[]));
        Cil.setFunctionTypeMakeFormals
          fun_dec_post (TFun(voidType,Some arg,false,[]));
        (* We will now fill the function with the result
           of the automaton's analysis. *)
        Globals.Functions.replace_by_definition
          (Cil.empty_funspec()) fun_dec_pre loc;
        Globals.Functions.replace_by_definition
          (Cil.empty_funspec()) fun_dec_post loc;
        let kf_pre = Globals.Functions.get vi_pre in
        let kf_post = Globals.Functions.get vi_post in
        let aux_func_pre, pre_block,pre_locals = mk_pre_fct_block kf_pre kf in
        let aux_func_post, post_block,post_locals =
          mk_post_fct_block
            kf_post kf (Extlib.opt_of_list fun_dec_post.sformals)
        in
        fun_dec_pre.slocals <- pre_locals;
        fun_dec_pre.sbody <- pre_block;
        fun_dec_pre.svar.vdefined <- true;
        fun_dec_post.slocals <- post_locals;
        fun_dec_post.sbody <- post_block;
        fun_dec_post.svar.vdefined <- true;
        let aux_funcs =
          Cil_datatype.Varinfo.Set.union aux_func_pre aux_func_post
        in
        let globs =
          Cil_datatype.Varinfo.Set.fold
            (fun x acc ->
               GFunDecl(Cil.empty_funspec(),x,loc) :: acc) aux_funcs
            [ GFun(fun_dec_pre,loc); GFun(fun_dec_post,loc)]
        in
        Cil_datatype.Varinfo.Set.iter (add_aux_bhv kf) aux_funcs;
        fundec.sbody.bstmts <-
          Cil.mkStmtOneInstr ~ghost:true
            (Call(None,Cil.evar ~loc vi_pre,
                  List.map (fun x -> Cil.evar ~loc x)
                    (Kernel_function.get_formals kf),
                  loc))
          :: fundec.sbody.bstmts;
        (* Finally, we update the CFG for the new fundec *)
        let keepSwitch = Kernel.KeepSwitch.get() in
        Cfg.prepareCFG ~keepSwitch fun_dec_pre;
        Cfg.cfgFun fun_dec_pre;
        Cfg.prepareCFG ~keepSwitch fun_dec_post;
        Cfg.cfgFun fun_dec_post;
        ChangeDoChildrenPost([g], fun x -> globs @ x)
      | _ -> DoChildren

    method! vstmt_aux stmt =
      match stmt.skind with
      | Return (res,loc)  ->
        let kf = Extlib.the self#current_kf in
        let vi = Kernel_function.get_vi kf in
        let current_function = vi.vname in
        if not (Data_for_aorai.isIgnoredFunction current_function) then begin
          let args = match res with
            | None -> []
            | Some exp -> [Cil.copy_exp exp]
          in
          let aux_vi =
            try Kernel_function.Hashtbl.find aux_post_table kf
            with Not_found ->
              Aorai_option.fatal
                "Function %a has no associated post_func"
                Kernel_function.pretty kf
          in
          let call =
            mkStmtOneInstr
              ~ghost:true (Call (None,Cil.evar ~loc aux_vi,args,loc))
          in
          let new_return = mkStmt ~valid_sid:true stmt.skind in
          let new_stmts = [call; new_return] in
          stmt.skind<-Block(Cil.mkBlock(new_stmts))
        end;
        SkipChildren
      | _ -> DoChildren

  end

(*********************************************************************)

(* update from formals of original C function to one of the auxiliary
   function (f_aux or f_pre)
*)
class change_formals old_kf new_kf =
  let old_formals = Kernel_function.get_formals old_kf in
  let new_formals = Kernel_function.get_formals new_kf in
  let formals = List.combine old_formals new_formals in
  object
    inherit Visitor.frama_c_inplace
    method! vlogic_var_use lv =
      match lv.lv_origin with
      | None -> SkipChildren
      | Some vi ->
        try
          let vi'= List.assq vi formals in
          ChangeTo (Cil.cvar_to_lvar vi')
        with Not_found -> SkipChildren

    method! vvrbl vi =
      try
        let vi' = List.assq vi formals in
        ChangeTo vi'
      with Not_found -> SkipChildren
  end

(* update \result to param of f_post when it exists. Must not be called if
   f_post has no parameter (original f returns void). *)
class change_result new_kf =
  let v = List.hd (Kernel_function.get_formals new_kf) in
  object
    inherit Visitor.frama_c_inplace
    method! vterm_lhost lh =
      match lh with
        TResult _ -> ChangeTo (TVar (Cil.cvar_to_lvar v))
      | _ -> DoChildren
  end

let post_treatment_loops = Hashtbl.create 97

let update_loop_assigns kf stmt state vi code_annot =
  let loc = Cil_datatype.Stmt.loc stmt in
  let assigns = Aorai_utils.aorai_assigns state loc in
  let assigns =
    Logic_utils.concat_assigns
      (Writes
         [Logic_const.new_identified_term (Logic_const.tvar ~loc vi), From []])
      assigns
  in
  let new_assigns =
    match code_annot.annot_content with
    | AAssigns (bhvs,old_assigns) ->
      Logic_const.new_code_annotation
        (AAssigns (bhvs, Logic_utils.concat_assigns old_assigns assigns))
    | _ -> Aorai_option.fatal "Expecting an assigns clause here"
  in
  (* we're putting the annotation on a new statement, with an empty
     loop assigns by construction. Don't keep_empty *)
  Annotations.add_code_annot
    ~keep_empty:false Aorai_option.emitter ~kf stmt new_assigns

let get_action_post_cond kf ?init_trans return_states =
  let to_consider pre_state int_states =
    match init_trans with
    | None -> true
    | Some init_trans ->
      try
        let possible_states =
          Data_for_aorai.Aorai_state.Map.find pre_state init_trans
        in
        not (Data_for_aorai.Aorai_state.Set.is_empty
               (Data_for_aorai.Aorai_state.Set.inter
                  int_states possible_states))
      with Not_found -> false
  in
  let treat_one_path pre_state post_state (int_states,_,bindings) acc =
    if to_consider pre_state int_states then begin
      let start = Logic_const.pre_label in
      let post_conds =
        Aorai_utils.action_to_pred ~start ~pre_state ~post_state bindings
      in
      Aorai_option.debug ~dkey
        "Getting action post-conditions for %a, from state %s to state %s@\n%a"
        Kernel_function.pretty kf
        pre_state.Promelaast.name post_state.Promelaast.name
        (Pretty_utils.pp_list ~sep:"@\n" Printer.pp_predicate)
        post_conds;
      post_conds @ acc
    end
    else acc
  in
  let treat_one_pre_state pre_state map acc =
    Data_for_aorai.Aorai_state.Map.fold (treat_one_path pre_state) map acc
  in
  let post_cond =
    Data_for_aorai.Aorai_state.Map.fold treat_one_pre_state return_states []
  in
  List.map
    (fun post_cond -> (Normal, Logic_const.new_predicate post_cond))
    post_cond

let make_zero_one_choice reachable_states =
  let treat_one_state state _ acc =
    (Logic_const.por
       (Aorai_utils.is_state_pred state,
        Aorai_utils.is_out_of_state_pred state)) :: acc
  in
  Data_for_aorai.Aorai_state.Map.fold treat_one_state reachable_states []

let needs_zero_one_choice states =
  let needs_choice =
    try
      ignore
        (Data_for_aorai.Aorai_state.Map.fold
           (fun _ _ flag -> if flag then raise Exit else true)
           states false);
      false
    with Exit -> true
  in
  if needs_choice then
    List.map
      Logic_const.new_predicate
      (make_zero_one_choice states)
  else []

let pred_reachable reachable_states =
  let treat_one_state (nb, reachable, unreachable) state =
    if Data_for_aorai.Aorai_state.Map.mem state reachable_states then
      (nb+1,
       Logic_const.por (reachable, Aorai_utils.is_state_pred state),
       unreachable)
    else
      (nb, reachable,
       Logic_const.pand (unreachable, Aorai_utils.is_out_of_state_pred state))
  in
  let (states,_) = Data_for_aorai.getGraph () in
  let (nb, reachable, unreachable) =
    List.fold_left treat_one_state (0,pfalse,ptrue) states
  in
  (nb > 1, reachable, unreachable)

let possible_start kf (start,int) =
  let auto = Data_for_aorai.getGraph () in
  let trans = Path_analysis.get_edges start int auto in
  let treat_one_trans cond tr =
    Logic_const.por
      (cond, Aorai_utils.crosscond_to_pred tr.cross kf Promelaast.Call)
  in
  let cond = List.fold_left treat_one_trans Logic_const.pfalse trans in
  Logic_const.pand (Aorai_utils.is_state_pred start, cond)

let neg_trans kf trans =
  let auto = Data_for_aorai.getGraph () in
  let rec aux l acc =
    match l with
    | [] -> acc
    | (start,stop) :: l ->
      let same_start, rest =
        List.fold_left
          (fun (same_start, rest) (start', stop' as elt) ->
             if Data_for_aorai.Aorai_state.equal start start' then
               stop' :: same_start, rest
             else
               same_start, elt :: rest)
          ([stop],[]) l
      in
      let cond =
        List.fold_left
          (fun cond stop ->
             let trans = Path_analysis.get_edges start stop auto in
             List.fold_left
               (fun cond tr ->
                  Logic_simplification.tand
                    cond (Logic_simplification.tnot tr.cross))
               cond trans)
          TTrue same_start
      in
      let cond = fst (Logic_simplification.simplifyCond cond) in
      let cond = Aorai_utils.crosscond_to_pred cond kf Promelaast.Call in
      let cond =
        Logic_const.por (Aorai_utils.is_out_of_state_pred start, cond)
      in
      aux rest (Logic_const.pand (acc,cond))
  in
  aux trans Logic_const.ptrue

let get_unchanged_aux_var loc current_state =
  let partition_action state (_,_,map) (actions,possible_states) =
    let possible_states =
      Data_for_aorai.Aorai_state.Set.add state possible_states
    in
    let treat_one_action t _ acc =
      let states =
        try Cil_datatype.Term.Map.find t acc
        with Not_found -> Data_for_aorai.Aorai_state.Set.empty
      in
      Cil_datatype.Term.Map.add t
        (Data_for_aorai.Aorai_state.Set.add state states) acc
    in
    let actions =
      Cil_datatype.Term.Map.fold treat_one_action map actions
    in (actions,possible_states)
  in
  let treat_one_action pre_hyp possible_states t action_states acc =
    if not (Data_for_aorai.Aorai_state.Set.is_empty
              (Data_for_aorai.Aorai_state.Set.diff
                 possible_states action_states))
    then begin
      let post_hyp =
        Data_for_aorai.Aorai_state.Set.fold
          (fun st acc ->
             Logic_const.pand ~loc (acc,Aorai_utils.is_out_of_state_pred st))
          action_states Logic_const.ptrue
      in
      let pred =
        Logic_const.new_predicate
          (Logic_const.pimplies ~loc
             (pre_hyp,
              Logic_const.pimplies ~loc
                (post_hyp,
                 Logic_const.prel ~loc (Req,t,Logic_const.told ~loc t))))
      in
      (Normal,pred) :: acc
    end else acc
    (* all possible states will update this lval, no need to
       make a special case here.
    *)
  in
  let treat_one_pre_state start map acc =
    let pre_hyp = Logic_const.pold ~loc (Aorai_utils.is_state_pred start) in
    let actions_map, possible_states =
      Data_for_aorai.Aorai_state.Map.fold
        partition_action map
        (Cil_datatype.Term.Map.empty, Data_for_aorai.Aorai_state.Set.empty)
    in
    Cil_datatype.Term.Map.fold
      (treat_one_action pre_hyp possible_states) actions_map acc
  in
  Data_for_aorai.Aorai_state.Map.fold treat_one_pre_state current_state []

(**
   This visitor adds a specification to each function and to each loop,
   according to specifications stored into Data_for_aorai.
*)
class visit_adding_pre_post_from_buch treatloops =

  let predicate_to_invariant kf stmt pred =
    let pred = Logic_const.toplevel_predicate pred in
    Annotations.add_code_annot
      Aorai_option.emitter
      ~kf
      stmt
      (Logic_const.new_code_annotation (AInvariant([],true,pred)));
  in
  let all_possible_states state =
    let treat_one_state _ = Data_for_aorai.merge_end_state in
    Data_for_aorai.Aorai_state.Map.fold
      treat_one_state state Data_for_aorai.Aorai_state.Map.empty
  in
  let condition_to_invariant kf possible_states stmt =
    (* Checks whether we have at least two possible automaton's states in the
       invariant. *)
    let has_multiple_choice =
      try
        ignore
          (Data_for_aorai.Aorai_state.Map.fold
             (fun _ _ b -> if b then raise Exit else true)
             possible_states false);
        false
      with Exit ->
        true
    in
    let treat_one_state s =
      if Data_for_aorai.Aorai_state.Map.mem s possible_states then begin
        if has_multiple_choice then begin
          let pred =
            Logic_const.por
              (Aorai_utils.is_state_pred s, Aorai_utils.is_out_of_state_pred s)
          in
          predicate_to_invariant kf stmt pred
        end else begin
          (* We can only be in one state. Since we must be in at least one
             state, the invariant is quite simple.
          *)
          predicate_to_invariant kf stmt (Aorai_utils.is_state_pred s)
        end
      end else begin
        let pred = Aorai_utils.is_out_of_state_pred s in
        predicate_to_invariant kf stmt pred
      end
    in
    let (states,_) = Data_for_aorai.getGraph () in
    List.iter treat_one_state states;
    if has_multiple_choice then begin
      let add_possible_state state _ acc =
        if Data_for_aorai.is_reject_state state then acc
        else
          Logic_const.por (acc,Aorai_utils.is_state_pred state)
      in
      let pred =
        Data_for_aorai.Aorai_state.Map.fold
          add_possible_state possible_states Logic_const.pfalse
      in
      predicate_to_invariant kf stmt pred
    end
  in
  let impossible_states_preds start possible_states my_state =
    let treat_one_start_state state start_state end_states acc =
      if not (Data_for_aorai.Aorai_state.Map.mem state end_states) then
        Logic_const.pimplies
          (Logic_const.pat(Aorai_utils.is_state_pred start_state, start),
           Aorai_utils.is_out_of_state_pred state)
        :: acc
      else acc
    in
    let treat_one_state state _ acc =
      Data_for_aorai.Aorai_state.Map.fold
        (treat_one_start_state state) my_state acc
    in
    Data_for_aorai.Aorai_state.Map.fold treat_one_state possible_states []
  in
  let impossible_states_preds_inv start possible_states my_state =
    let treat_one_start_state state start_state end_states acc =
      if Data_for_aorai.Aorai_state.Map.mem state end_states then
        Logic_const.pand
          (acc,
           Logic_const.pat(Aorai_utils.is_out_of_state_pred start_state, start))
      else acc
    in
    let treat_one_state state _ acc =
      let out_states =
        Data_for_aorai.Aorai_state.Map.fold
          (treat_one_start_state state) my_state Logic_const.ptrue
      in
      if Data_for_aorai.Aorai_state.Map.cardinal my_state = 1 &&
         not (Logic_utils.is_trivially_true out_states)
      then acc (* we only have a single entry state: we can't possibly be
                  out of it, or another annotation above is invalid. No need
                  to put an implication with a false lhs.
               *)
      else
        Logic_const.pimplies
          (out_states, Aorai_utils.is_out_of_state_pred state)
        ::acc
    in
    Data_for_aorai.Aorai_state.Map.fold treat_one_state possible_states []
  in
  let partition_pre_state map =
    let (states,_) = Data_for_aorai.getGraph () in
    let is_equiv st1 st2 =
      let check_one _ o1 o2 =
        match o1, o2 with
        | None, None | Some _, Some _ -> Some ()
        | None, Some _ | Some _, None -> raise Not_found
      in
      try
        ignore (Data_for_aorai.Aorai_state.Map.merge check_one st1 st2); true
      with Not_found -> false
    in
    let find_equivs (start,state, end_states) equivs =
      let rec aux = function
        | [] -> [[start,state],end_states]
        | (equiv_class,end_states2 as infos) :: l ->
          if is_equiv end_states end_states2 then
            ((start, state) :: equiv_class, end_states2) :: l
          else infos :: aux l
      in aux equivs
    in
    let filter equivs state =
      let check_one_state start end_states equivs =
        let end_states =
          Data_for_aorai.Aorai_state.Map.filter
            (fun _ (int_states,_,_) ->
               Data_for_aorai.Aorai_state.Set.mem state int_states)
            end_states
        in
        if Data_for_aorai.Aorai_state.Map.is_empty end_states then equivs
        else find_equivs (start, state, end_states) equivs
      in
      Data_for_aorai.Aorai_state.Map.fold check_one_state map equivs
    in
    let res = List.fold_left filter [] states in
    List.map fst res
  in
  let update_assigns loc kf ki spec =
    let update_assigns bhv =
      (* NB: The assigns for a statement contract is a bit overapproximated,
         (includes assigns of the whole function), but we don't really have
         a better information at this point.
      *)
      let assigns =
        Aorai_utils.aorai_assigns (Data_for_aorai.get_kf_return_state kf) loc
      in
      match ki with
      | Kstmt stmt -> (* stmt contract *)
        if bhv.b_assigns <> WritesAny then begin
          let bhv_aorai = Cil.mk_behavior ~name:bhv.b_name ~assigns () in
          let spec = Cil.empty_funspec () in
          spec.spec_behavior <- [ bhv_aorai ];
          let ca = Logic_const.new_code_annotation (AStmtSpec ([],spec)) in
          Annotations.add_code_annot Aorai_option.emitter ~kf stmt ca
        end
      | Kglobal -> (* function contract *)
        Annotations.add_assigns
          ~keep_empty:true
          Aorai_option.emitter
          kf
          ~behavior:bhv.b_name
          assigns;
    in
    List.iter update_assigns spec.spec_behavior
  in
  let mk_auto_fct_spec kf status auto_state =
    let loc = Kernel_function.get_location kf in
    Aorai_utils.auto_func_behaviors loc kf status auto_state
  in
  let mk_pre_fct_spec kf =
    mk_auto_fct_spec kf Promelaast.Call (Data_for_aorai.get_kf_init_state kf)
  in
  let mk_post_fct_spec kf =
    mk_auto_fct_spec kf
      Promelaast.Return (Data_for_aorai.get_kf_return_state kf)
  in
  let needs_post kf =
    let loc = Kernel_function.get_location kf in
    let return_state = Data_for_aorai.get_kf_return_state kf in
    let possible_states =
      Data_for_aorai.Aorai_state.Map.fold
        (fun _ map acc ->
           Data_for_aorai.Aorai_state.Map.fold
             (fun st _ acc -> Data_for_aorai.Aorai_state.Set.add st acc)
             map acc)
        return_state Data_for_aorai.Aorai_state.Set.empty
    in
    let action_post = get_unchanged_aux_var loc return_state in
    if
      Data_for_aorai.Aorai_state.Set.exists
        Data_for_aorai.is_reject_state possible_states
    then
      (* We must ensure that there is at least one active state
         beside the rejection state *)
      let cond =
        Data_for_aorai.Aorai_state.Set.fold
          (fun st acc ->
             if Data_for_aorai.is_reject_state st then acc
             else Logic_const.por (Aorai_utils.is_state_pred st,acc))
          possible_states Logic_const.pfalse
      in
      (Normal,Logic_const.new_predicate cond) :: action_post
    else action_post
  in
  let mk_post kf =
    let return_state = Data_for_aorai.get_kf_return_state kf in
    (*   + Post-condition registration *)
    (* If several states are associated to the same post-condition,
       then their specification is factorised. *)
    let equivs = partition_pre_state return_state in
    let bhvs =
      match equivs with
      | [ e ] -> (* we just have one possible case, no need to generate
                    assumes and a negative behavior
                 *)
        let name = "Buchi_property_behavior" in
        let s = fst (List.hd e) in
        let reachable_states =
          Data_for_aorai.Aorai_state.Map.find s return_state
        in
        let (multi_choice, reachable, unreachable) =
          pred_reachable reachable_states
        in
        let post_cond = Normal, Logic_const.new_predicate reachable in
        let post_cond =
          if Aorai_option.Deterministic.get () then [post_cond]
          else
            [Normal, Logic_const.new_predicate unreachable; post_cond]
        in
        let post_cond =
          if multi_choice && not (Aorai_option.Deterministic.get ()) then
            begin
              let preds = make_zero_one_choice reachable_states in
              List.fold_left
                (fun acc p ->
                   (Normal, Logic_const.new_predicate p) :: acc)
                post_cond preds
            end
          else post_cond
        in
        let infos = Aorai_utils.get_preds_post_bc_wrt_params kf in
        let post_cond =
          if Logic_utils.is_trivially_true infos then post_cond
          else (Normal, Logic_const.new_predicate infos) :: post_cond
        in
        let post_cond = post_cond @ get_action_post_cond kf return_state in
        [Cil.mk_behavior ~name ~post_cond ()]
      | _ ->
        let _,bhvs =
          List.fold_left
            (fun (i,acc) equiv ->
               let (case_start, case_int) = List.hd equiv in
               let assumes_l =
                 List.map (possible_start kf) equiv
               in
               let name = "Buchi_behavior_in_" ^ (string_of_int i) in
               let assumes =
                 [Logic_const.new_predicate (Logic_const.pors assumes_l)]
               in
               let reachable_states =
                 Data_for_aorai.Aorai_state.Map.find case_start return_state
               in
               let reachable_states =
                 Data_for_aorai.Aorai_state.Map.filter
                   (fun _ (int,_,_) ->
                      Data_for_aorai.Aorai_state.Set.mem case_int int)
                   reachable_states
               in
               let (multi_choice, reachable, _) =
                 pred_reachable reachable_states
               in
               let post_cond =
                 [Normal, Logic_const.new_predicate reachable]
               in
               let post_cond =
                 if multi_choice && not (Aorai_option.Deterministic.get()) then
                   begin
                     let preds = make_zero_one_choice reachable_states in
                     List.fold_left
                       (fun acc p ->
                          (Normal, Logic_const.new_predicate p) :: acc)
                       post_cond preds
                   end
                 else post_cond
               in
               let infos = Aorai_utils.get_preds_post_bc_wrt_params kf in
               let post_cond =
                 if Logic_utils.is_trivially_true infos then post_cond
                 else (Normal, Logic_const.new_predicate infos) :: post_cond
               in
               let init_trans =
                 List.fold_left
                   (fun acc (start, int) ->
                      let set =
                        try Data_for_aorai.Aorai_state.Map.find start acc
                        with Not_found -> Data_for_aorai.Aorai_state.Set.empty
                      in
                      Data_for_aorai.Aorai_state.Map.add
                        start
                        (Data_for_aorai.Aorai_state.Set.add int set)
                        acc)
                   Data_for_aorai.Aorai_state.Map.empty
                   equiv
               in
               let post_cond =
                 post_cond @
                 (get_action_post_cond kf ~init_trans return_state)
               in
               (i+1,
                Cil.mk_behavior ~name ~assumes ~post_cond () :: acc))
            (0,[])
            equivs
        in
        if Aorai_option.Deterministic.get () then bhvs
        else begin
          (* post-conditions for state in which we are not at the
             end of the functions. They have to be grouped differently
             than positive information because of non-determinism (if two
             non-equivalent states are active when entering the function
             and activate the same state at exit) *)
          let aux (i,bhvs) state =
            let name = "Buchi_behavior_out_" ^ (string_of_int i) in
            let select_equivalence_class equiv =
              let (start, int) = List.hd equiv in
              try
                let map =
                  Data_for_aorai.Aorai_state.Map.find start return_state
                in
                let (int_states, _,_) =
                  Data_for_aorai.Aorai_state.Map.find state map
                in
                Data_for_aorai.Aorai_state.Set.mem int int_states
              with Not_found -> false
            in
            let my_trans =
              List.fold_left
                (fun acc equiv ->
                   if select_equivalence_class equiv then
                     acc @ equiv
                   else acc)
                [] equivs
            in
            let assumes = neg_trans kf my_trans in
            if Logic_utils.is_trivially_false assumes then (i+1,bhvs)
            else
              let p = Aorai_utils.is_out_of_state_pred state in
              let post_cond = [Normal, Logic_const.new_predicate p] in
              let bhv =
                if Logic_utils.is_trivially_true assumes then
                  Cil.mk_behavior ~name ~post_cond ()
                else begin
                  let assumes = [Logic_const.new_predicate assumes] in
                  Cil.mk_behavior ~name ~assumes ~post_cond ()
                end
              in
              (i+1,bhv :: bhvs)
          in
          let (states,_) = Data_for_aorai.getGraph () in
          List.rev (snd (List.fold_left aux (0,bhvs) states))
        end
    in
    (* If this is the main function, we should exit in at least one
       acceptance state.
    *)
    let bhvs =
      if Aorai_option.ConsiderAcceptance.get () &&
         Datatype.String.equal
           (Kernel_function.get_name kf) (Kernel.MainFunction.get())
      then
        let accept = Logic_const.new_predicate (get_acceptance_pred()) in
        let post_cond = [Normal, accept] in
        let name = "aorai_acceptance" in
        Cil.mk_behavior ~name ~post_cond () :: bhvs
      else bhvs
    in
    if Aorai_option.AddingOperationNameAndStatusInSpecification.get()
    then begin
      let called_post =
        Logic_const.new_predicate
          (Logic_const.prel
             (Req ,
              Logic_const.tvar
                (Data_for_aorai.get_logic_var Data_for_aorai.curOpStatus),
              Logic_const.term
                (TConst
                   (Logic_utils.constant_to_lconstant
                      (Data_for_aorai.op_status_to_cenum Promelaast.Return)))
                (Ctype Cil.intType)))
      in
      let called_post_2 =
        Logic_const.new_predicate
          (Logic_const.prel
             (Req,
              Logic_const.tvar
                (Data_for_aorai.get_logic_var Data_for_aorai.curOp),
              Logic_const.term
                (TConst
                   (Logic_utils.constant_to_lconstant
                      (Data_for_aorai.func_to_cenum
                         (Kernel_function.get_name kf))))
                (Ctype Cil.intType)))
      in
      let name = "Buchi_property_behavior_function_states" in
      let post_cond = [Normal, called_post; Normal, called_post_2] in
      Cil.mk_behavior ~name ~post_cond () :: bhvs
    end else bhvs
  in
  object(self)

    inherit Visitor.frama_c_inplace

    (* We have to update assigns whenever a call occurs in the scope of
       a statement contract (function always update the automaton's state,
       so assigns there have to be changed anyway.) *)
    val has_call = Stack.create ()

    method private enter_block () = Stack.push (ref false) has_call

    method private call () = Stack.iter (fun x -> x := true) has_call

    method private leave_block () = !(Stack.pop has_call)

    method! vfunc f =
      let my_kf = Extlib.the self#current_kf in
      let vi = Kernel_function.get_vi my_kf in
      let spec = Annotations.funspec my_kf in
      let loc = Kernel_function.get_location my_kf in
      (match kind_of_func vi with
       | Pre_func _ | Post_func _ | Aux_func _ -> ()
       | Not_auto_func -> (* Normal C function *)
         let bhvs = mk_post my_kf in
         let my_state = Data_for_aorai.get_kf_init_state my_kf in
         let requires = needs_zero_one_choice my_state in
         let requires =
           Aorai_utils.auto_func_preconditions
             loc my_kf Promelaast.Call my_state
           @ requires
         in
         let post_cond = needs_post my_kf in
         match Cil.find_default_behavior spec with
         | Some b ->
           let behavior = b.b_name in
           Annotations.add_requires
             Aorai_option.emitter my_kf ~behavior requires;
           Annotations.add_ensures
             Aorai_option.emitter my_kf ~behavior post_cond;
           Annotations.add_behaviors Aorai_option.emitter my_kf bhvs
         | None ->
           let bhv = Cil.mk_behavior ~requires ~post_cond () in
           Annotations.add_behaviors Aorai_option.emitter my_kf (bhv :: bhvs));
      let after f = update_assigns f.svar.vdecl my_kf Kglobal spec; f in
      ChangeDoChildrenPost(f,after)

    method! vglob_aux g =
      match g with
      | GFun(f,_)  ->
        let my_kf = Extlib.the self#current_kf in
        (* don't use get_spec, as we'd generate default assigns,
           while we'll fill the spec just below. *)
        let vi = Kernel_function.get_vi my_kf in
        (match kind_of_func vi with
         | Pre_func kf ->
           (* must advance the automaton according to current call. *)
           let bhvs = mk_pre_fct_spec kf in
           let vis = new change_formals kf my_kf in
           let bhvs =
             Visitor.visitFramacBehaviors vis bhvs
           in
           Annotations.add_behaviors Aorai_option.emitter my_kf bhvs;
           f.sbody <- Visitor.visitFramacBlock vis f.sbody;
           SkipChildren
         | Post_func kf ->
           (* must advance the automaton according to return event. *)
           let (rt, _, _, _) =
             Cil.splitFunctionTypeVI (Kernel_function.get_vi kf)
           in
           let bhvs = mk_post_fct_spec kf in
           let bhvs =
             (* if return type is not void, convert \result in the formal
                arg of current kf. Otherwise, there's no conversion to do. *)
             if Cil.isVoidType rt then bhvs
             else (Visitor.visitFramacBehaviors
                     (new change_result my_kf) (* LBLsformals : change_result must not be called
                                                  if f_post has no arguments, ie no formals for a
                                                  function declaration.
                                                  That's why we had to update sformals. *)
                     bhvs;)

           in
           Annotations.add_behaviors Aorai_option.emitter my_kf bhvs;
           SkipChildren
         | Aux_func _ | Not_auto_func ->
           DoChildren (* they are not considered here. *))

      | _ -> DoChildren;

    method! vstmt_aux stmt =
      let kf = Extlib.the self#current_kf in
      let treat_loop body_ref stmt =
        let init_state = Data_for_aorai.get_loop_init_state stmt in
        let inv_state = Data_for_aorai.get_loop_invariant_state stmt in

        let possible_states =
          Data_for_aorai.merge_end_state
            (all_possible_states init_state) (all_possible_states inv_state)
        in
        let loop_assigns =
          Annotations.code_annot ~filter:Logic_utils.is_assigns stmt
        in
        (* varinfo of the init_var associated to this loop *)
        let vi_init =
          Data_for_aorai.get_varinfo
            (Data_for_aorai.loopInit ^ "_" ^ string_of_int stmt.sid)
        in

        (*    1) The associated init variable is set to 0 in first position
              (or in second position if the first stmt is a if)*)

        let loc = Cil_datatype.Stmt.loc stmt in
        let stmt_varset =
          Cil.mkStmtOneInstr ~ghost:true ~valid_sid:true
            (Set((Var vi_init,NoOffset), Cil.zero ~loc, loc))
        in
        begin
          (* Function adapted from the cil printer *)
          try
            let rec skipEmpty = function
                [] -> []
              | {skind=Instr (Skip _);labels=[]} :: rest -> skipEmpty rest
              | x -> x
            in
            match skipEmpty !body_ref.bstmts with
            | {skind=If(_,tb,fb,_)} as head:: _ ->
              begin
                match skipEmpty tb.bstmts, skipEmpty fb.bstmts with
                | _, {skind=Break _}:: _
                | _, {skind=Goto _} :: _
                | {skind=Goto _} :: _, _
                | {skind=Break _} :: _, _ ->
                  !body_ref.bstmts <-
                    head :: stmt_varset :: List.tl !body_ref.bstmts
                | _ ->
                  raise Not_found
              end
            | _ -> raise Not_found
          with Not_found ->
            !body_ref.bstmts<-stmt_varset::!body_ref.bstmts
        end;

        (*    2) The associated init variable is set to 1 before the loop *)
        let new_loop = mkStmt ~valid_sid:true stmt.skind in
        let stmt_varset =
          Cil.mkStmtOneInstr ~ghost:true ~valid_sid:true
            (Set((Var(vi_init),NoOffset), Cil.one ~loc, loc))
        in
        let block = mkBlock [stmt_varset;new_loop] in
        stmt.skind<-Block(block);

        (* Overcome WP limitation wrt LoopEntry. See bug 1353 *)
        new_loop.labels <-
          [ Label ("aorai_loop_" ^ string_of_int stmt.sid,
                   Cil_datatype.Stmt.loc stmt, false)];
        let loop_entry_label = StmtLabel (ref new_loop) in

        (*    3) Generation of the loop invariant *)
        let mk_imply operator predicate =
          pimplies
            (prel(operator,
                  Aorai_utils.mk_term_from_vi vi_init,
                  Aorai_utils.zero_term()),
             predicate)
        in
        (* The loop invariant is :
           (Global invariant)  // all never reached state are set to zero
           & (Init => Pre1)      // external pre-condition
           & (not Init => Post2) // internal post-condition
           & counter_invariant   // values of counters.
           (init: fresh variable which indicates if the iteration is the first
           one). *)
        condition_to_invariant kf possible_states new_loop;

        let init_preds =
          impossible_states_preds Logic_const.pre_label possible_states init_state
        in
        let treat_init_pred pred =
          let pred = mk_imply Rneq pred in
          predicate_to_invariant kf new_loop pred
        in
        List.iter treat_init_pred init_preds;
        let invariant_preds =
          impossible_states_preds_inv loop_entry_label possible_states inv_state
        in
        let treat_inv_pred pred =
          let pred = mk_imply Req pred in
          predicate_to_invariant kf new_loop pred
        in
        List.iter treat_inv_pred invariant_preds;

        let action_inv_preds =
          Aorai_utils.all_actions_preds loop_entry_label inv_state
        in
        List.iter (predicate_to_invariant kf new_loop) action_inv_preds;

        List.iter
          (update_loop_assigns kf new_loop inv_state (Cil.cvar_to_lvar vi_init))
          loop_assigns;

        (*    4) Keeping in mind to preserve old annotations after visitor end *)
        Hashtbl.add post_treatment_loops (ref stmt) (ref new_loop);

        (*    5) Updated stmt is returned *)
        stmt
      in
      self#enter_block ();
      let after s =
        if self#leave_block () then
          let annots = Annotations.code_annot stmt in
          let _, specs = List.split (Logic_utils.extract_contract annots) in
          List.iter
            (update_assigns
               (Cil_datatype.Stmt.loc stmt)
               (Extlib.the self#current_kf)
               (Kstmt stmt))
            specs;
          s
        else
          s
      in
      if treatloops then
        match stmt.skind with
        | Loop (_,block,_,_,_) ->
          ChangeDoChildrenPost(stmt, after $ (treat_loop (ref block)))

        | _ -> ChangeDoChildrenPost(stmt, after)
      else
        ChangeDoChildrenPost(stmt,after)

    method! vinst = function
      | Call _ | Local_init (_, ConsInit _, _) -> self#call (); DoChildren
      | _ -> DoChildren

  end

let add_pre_post_from_buch file treatloops  =
  let visitor = new visit_adding_pre_post_from_buch treatloops in
  Cil.visitCilFile (visitor :> Cil.cilVisitor) file;
  (* Transfer previous annotation on the new loop statement.
     Variant clause has to be preserved at the end of the annotation.*)
  Hashtbl.iter
    (fun old_stmt new_stmt ->
       let new_s = !new_stmt in
       let old_s = !old_stmt in
       let kf = Kernel_function.find_englobing_kf old_s in
       (* Erasing annotations from the old statement before attaching them with
          the new one *)
       let annots =
         Annotations.fold_code_annot
           (fun e a acc ->
              Annotations.remove_code_annot e ~kf old_s a;
              if (Logic_utils.is_assigns a) then acc else (e, a) :: acc)
           old_s
           [];
       in
       List.iter (fun (e, a) -> Annotations.add_code_annot e ~kf new_s a) annots)
    post_treatment_loops

let add_sync_with_buch file  =
  let visitor = new visit_adding_code_for_synchronisation in
  Cil.visitCilFile (visitor :> Cil.cilVisitor) file

(*
Local Variables:
compile-command: "make -C ../../.."
End:
*)
