(************************************************

Rtac definition

************************************************)

Ltac reify_expr_tac :=
match goal with
| [ |- ?trm] => reify_vst trm
end.Ltac do_local2ptree := do 2 (erewrite local2ptree_soundness; [ | repeat constructor ]);
repeat rewrite LocalD_to_localD.Ltac extract_sep_lift_semax :=
  match goal with
      [ |- context [semax _ (*(PROP (?P1) (LOCALx ?Q1 SEP (?R1)))*)
                 (PROPx ?P1 (LOCALx ?Q1 (SEPx ?R1))) _
                 (normal_ret_assert (*(PROPx ?P2 (LOCALx ?Q2 (SEPx ?R2))))*) _)]] =>
      let R1' := pull_sep_lift R1 in
      (*let R2' := pull_sep_lift R2 in*)
      try (change (PROPx (P1) (LOCALx Q1 (SEPx (R1))))
      with (assertD nil Q1 R1'))(*;
      try  (change (PROPx (P2) (LOCALx Q2 (SEPx (R2))))
      with (assertD nil Q2 R2'))*)
end.Ltac hnf_tycontext :=
match goal with
[ |- context [semax ?s _ _ _] ] => let ss := eval hnf in s in change s with ss
end.Ltac prepare_reify :=
do_local2ptree;
extract_sep_lift_semax;
hnf_tycontext.Definition remove_global_spec (t : tycontext) :=
match t with
| mk_tycontext t v r gt gs => mk_tycontext t v r gt (PTree.empty _)
end.(************************************************

Pre-rtac computations

************************************************)

Definition is_array_type (t: Ctypes.type) : bool :=
  match t with
  | Tarray _ _ _ => true
  | _ => false
  end.Fixpoint no_load_expr_bool (e: Clight.expr) : bool :=
  match e with
  | Econst_int _ _ => true
  | Econst_float _ _ => true
  | Econst_single _ _ => true
  | Econst_long _ _ => true
  | Evar _ t => is_array_type t
  | Etempvar _ _ => true
  | Ederef _ _ => false
  | Eaddrof e0 _ => no_load_lvalue_bool e0
  | Eunop _ e0 _ => no_load_expr_bool e0
  | Ebinop _ e0 e1 _ => (no_load_expr_bool e0 && no_load_expr_bool e1)%bool
  | Ecast e0 _ => no_load_expr_bool e0
  | Efield e0 _ t => (is_array_type t && no_load_lvalue_bool e0)%bool
  end
with no_load_lvalue_bool (e: Clight.expr) : bool :=
  match e with
  | Econst_int _ _ => false
  | Econst_float _ _ => false
  | Econst_single _ _ => false
  | Econst_long _ _ => false
  | Evar _ _ => true
  | Etempvar _ _ => false
  | Ederef _ _ => false
  | Eaddrof _ _ => false
  | Eunop _ _ _ => false
  | Ebinop _ _ _ _ => false
  | Ecast _ _ => false
  | Efield e0 _ _ => no_load_lvalue_bool e0
  end.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Inductive ForwardRule : Type :=
| ForwardSet
| ForwardLoad
| ForwardCastLoad
| ForwardStore
| ForwardSeq: statement -> statement -> ForwardRule
| ForwardSkip.Definition compute_forward_rule (s: statement) : option ForwardRule :=
  match s with
  | Sskip => Some ForwardSkip
  | Ssequence s1 s2 => Some (ForwardSeq s1 s2)
  | Sassign _ _ => Some ForwardStore
  | Sset _ e =>
    if no_load_expr_bool e
    then Some ForwardSet
    else match e with
         | Ecast _ _ => Some ForwardCastLoad
         | _ => Some ForwardLoad
         end
  | _ => None
  end.Definition get_arguments_delta (e : expr typ func) :=
  match e with
  | App (Inj (inr (Smx (ftycontext t v r gt)))) gf => Some (t, v, r, gt, gf)
  | _ => None
  end.Definition get_arguments_pre (e : expr typ func) :=
  match e with
  | App (App (App (Inj (inr (Smx fassertD))) P)
      (App (App (Inj (inr (Smx flocalD))) T1) T2)) R => Some (P, T1, T2, R, rstrip_1_later_sep R)
  | _ => None
  end.Definition get_arguments_statement (e : expr typ func) :=
  match e with
  | Inj (inr (Smx (fstatement s))) => Some s
  | _ => None
  end.Fixpoint get_arguments (e : expr typ func) :=
match e with
| App (App (App (App (App (Inj (inr (Smx fsemax))) _) Delta) Pre) CCmd) _ =>
  (get_arguments_delta Delta,
   get_arguments_pre Pre,
   get_arguments_statement CCmd)
| App _ e
| Abs _ e => get_arguments e
| _ => (None, None, None)
end.Definition compute_hlip_arg (arg:
         (PTree.t (type * bool) * PTree.t type * type * PTree.t type *
          expr typ func) *
       (expr typ func * expr typ func * expr typ func * expr typ func * expr typ func) *
       statement) :=
  match arg with
  | ((t, v, r, gt, _), (_, _, _, R, _), s) => (t, v, r, gt, s, R)
  end.Instance RSym_SymEnv_fun : RSym SymEnv.func := {
  typeof_sym := fun _ => None;
  symD := fun _ => tt;
  sym_eqb := fun x y => Some (Pos.eqb x y)
}.Instance RSymOk_SymEnv_fun : RSymOk RSym_SymEnv_fun.Definition sem_eqb_func := @sym_eqb _ _ _ (SymSum.RSym_sum
  (SymSum.RSym_sum (SymSum.RSym_sum RSym_SymEnv_fun RSym_ilfunc) RSym_bilfunc)
  RSym_Func').Fixpoint expr_beq (e1 e2: expr typ func) : bool :=
  match e1, e2 with
  | Var i1, Var i2 => beq_nat i1 i2
  | Inj f1, Inj f2 =>
    match sem_eqb_func f1 f2 with
    | Some true => true
    | _ => false
    end
  | App e11 e12, App e21 e22 => andb (expr_beq e11 e21) (expr_beq e12 e22)
  | Abs ty1 e11, Abs ty2 e21 => andb (expr_beq e11 e21) (typ_beq ty1 ty2)
  | UVar i1, UVar i2 => beq_nat i1 i2
  | _, _ => false
  end.Fixpoint nth_solver_rec (R: expr typ func) (p: expr typ func) (n: nat) :=
match R with
| Inj (inr (Data (fnil tympred))) => None
| App (App (Inj (inr (Data (fcons tympred)))) hd) tl =>
  match hd with
  | App (App (App (Inj (inr (Sep (fdata_at t_root)))) sh) v) p' =>
      if (expr_beq p p')
      then Some (t_root, n)
      else nth_solver_rec tl p (S n)
  | _ => nth_solver_rec tl p (S n)
  end
| _ => None
end.Definition nth_solver R p := nth_solver_rec R p 0.Definition compute_store_arg (arg:
         (PTree.t (type * bool) * PTree.t type * type * PTree.t type *
          expr typ func) *
       (expr typ func * expr typ func * expr typ func * expr typ func * expr typ func) *
       statement) :=
  match arg with
  | ((t, v, r, gt, _), (_, T1, T2, _, R'), s) =>
    match s with
    | Sassign e0 e2 =>
      match compute_nested_efield e0 with
      | (e1, efs, tts) =>
        let ty := typeof e0 in
        let lr := compute_lr e1 efs in
        match rmsubst_eval_LR T1 T2 e1 lr with
        | App (Inj (inr (Other (fsome tyval)))) p =>
          match nth_solver R' p with
          | Some (t_root, n) =>
              Some (t, v, r, gt, ty, t_root, e0, e1, e2, efs, tts, lr, n)
          | _ => None
          end
        | _ => None
        end
      end
    | _ => None
    end
  end.

(* Specifications: *)
Lemma semax_seq_reif c1 c2 : forall (Espec : OracleKind) (P : environ -> mpred) (P' : environ -> mpred) (Q : ret_assert) (Delta : tycontext) , @semax Espec Delta P c1 (normal_ret_assert P') -> @semax Espec (update_tycon Delta c1) P' c2 Q -> @semax Espec Delta P (Ssequence c1 c2) Q.