From Coq Require Import ZArith List.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq ssrfun.
From BitBlasting Require Import QFBV CNF BBCommon BBConst BBXor BBEq BBZeroExtend BBNeg BBAnd BBAdd BBShl BBSub BBMul BBAshr BBUge BBUdiv BBLneg BBSdiv BBOr BBNot BBNeg.
From ssrlib Require Import ZAriths Tactics.
From nbits Require Import NBits.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(* ===== bit_blast_smod ===== *)

Definition bit_blast_smod g ls1 ls2 : generator * cnf * word :=
  let (ls1_tl, ls1_sign) := eta_expand (splitmsl ls1) in
  let (ls2_tl, ls2_sign) := eta_expand (splitmsl ls2) in
  let '(g_srem, cs_srem, lrs_srem) := bit_blast_srem g ls1 ls2 in
  let '(g_eq, cs_eq, r_eq) := bit_blast_eq g_srem (ls1_sign::nil) (ls2_sign::nil) in
  let '(g_eq2, cs_eq2, r_eq2) := bit_blast_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff) in
  if (r_eq == lit_tt) || (r_eq2 == lit_tt) then
    (g_eq2, catrev cs_srem (catrev cs_eq2 cs_eq), lrs_srem)
  else if (r_eq == lit_ff) && (r_eq2 == lit_ff) then
    let '(g_add, cs_add, lrs_add) := bit_blast_add g_eq2 lrs_srem ls2 in
    (g_add, catrev cs_srem (catrev cs_eq (catrev cs_eq2 cs_add)), lrs_add)
       else let '(g_or, cs_or, lrs_or) := bit_blast_or g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2) in
            let '(g_not, cs_not, lrs_not) := bit_blast_not g_or lrs_or in
            let '(g_and2, cs_and2, lrs_and2) := bit_blast_and g_not ls2 lrs_not in
            let '(g_add2, cs_add2, lrs_add2) := bit_blast_add g_and2 lrs_srem lrs_and2 in
            (g_add2, catrev cs_srem (catrev cs_eq (catrev cs_eq2 (catrev cs_or (catrev cs_not (catrev cs_and2 cs_add2))))), lrs_add2).

Lemma bit_blast_smod_correct g ls1 ls2 g' cs rlrs E bs1 bs2 :
  bit_blast_smod g ls1 ls2 = (g', cs, rlrs) ->
  size ls1 = size ls2 ->
  0 < size ls1 ->
  enc_bits E ls1 bs1 ->
  enc_bits E ls2 bs2 ->
  interp_cnf E (add_prelude cs) ->
  enc_bits E rlrs (smodB bs1 bs2).
Proof.
  rewrite /bit_blast_smod.
  dcase (bit_blast_srem g ls1 ls2) => [[[g_srem] cs_srem] r_rem] Hbbsrem.
  dcase (bit_blast_eq g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2]) => [[[g_eq] cs_eq] r_eq] Hbbeq.
  dcase (bit_blast_eq g_eq r_rem (copy (size r_rem) lit_ff)) => [[[g_eq2] cs_eq2] r_eq2] Hbbeq2.
  dcase (bit_blast_add g_eq2 r_rem ls2) => [[[g_add] cs_add] r_add] Hbbadd.
  dcase (bit_blast_or g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2)) => [[[g_or] cs_or] lrs_or] Hbbor.
  dcase (bit_blast_not g_or lrs_or)  => [[[g_not] cs_not] lrs_not] Hbbnot.
  dcase (bit_blast_and g_not ls2 lrs_not) => [[[g_and2] cs_and2] r_and2] Hbband2.
  dcase (bit_blast_add g_and2 r_rem r_and2) => [[[g_add2] cs_add2] r_add2] Hbbadd2.
  case Heq :(r_eq == lit_tt); last case Heq2 : (r_eq2 == lit_tt).
  - rewrite/=; case => _ <- <-.
    move => Hsz12 Hgt02 Henc1 Henc2.
    rewrite 2!add_prelude_catrev. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq2 Hcseq].
    rewrite/smodB.
    move : (add_prelude_tt Hcssrem) => Htt.
    have Hszmsl12 : size [:: (splitmsl ls1).2] = size [:: (splitmsl ls2).2] by done.
    move/andP : (enc_bits_splitmsb Htt Henc1) => [Henc1r Hencmsb1].
    move/andP : (enc_bits_splitmsb Htt Henc2) => [Henc2r Hencmsb2].
    have Hencmsb1nil : enc_bits E [::(splitmsl ls1).2] [::(splitmsb bs1).2] by rewrite enc_bits_cons Hencmsb1 enc_bits_nil.
    have Hencmsb2nil : enc_bits E [::(splitmsl ls2).2] [::(splitmsb bs2).2] by rewrite enc_bits_cons Hencmsb2 enc_bits_nil.
    move : (bit_blast_eq_correct Hbbeq Hszmsl12 Hencmsb1nil Hencmsb2nil Hcseq). (*=> Henceqr.*)
    rewrite (eqP Heq). (*in Henceqr. generalize Henceqr.*)
    rewrite (add_prelude_enc_bit_true ([:: (splitmsb bs1).2] == [:: (splitmsb bs2).2]) Hcseq) Seqs.singleton_eq-/(msb bs1) -/(msb bs2).
    move => Hmsb12. rewrite Hmsb12 orTb.
    exact : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => Hencr.
  - rewrite /=; case => _ <- <-. move => Hsz12 Hgt02 Henc1 Henc2.
    rewrite 2!add_prelude_catrev /smodB. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq2 Hcseq].
    have Hszcprrem : size r_rem = size (copy (size r_rem) lit_ff) by rewrite size_nseq.
    move : (add_prelude_enc_bit_ff Hcssrem) => Hencff.
    move : (enc_bits_copy (size r_rem) Hencff) => Henccpff.
    move : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => Hencr.
    move : (bit_blast_eq_correct Hbbeq2 Hszcprrem Hencr Henccpff Hcseq2).
    rewrite (eqP Heq2) (add_prelude_enc_bit_true ((sremB bs1 bs2) == copy (size r_rem) false) Hcseq2). move => HsremB.
    rewrite (eqP HsremB) size_copy {1}/zeros {1}/b0 eq_refl orbT.
    rewrite (eqP HsremB)// in Hencr.
  - case Heqf: (r_eq == lit_ff); case Heqf2: (r_eq2 == lit_ff).
    + rewrite/=; case => _ <- <-. move => Hsz12 Hgt02 Henc1 Henc2.
      rewrite 3!add_prelude_catrev /smodB. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq Hcsu]; move/andP : Hcsu => [Hcseq2 Hcsadd].
      have Hszmsl12 : size [:: (splitmsl ls1).2] = size [:: (splitmsl ls2).2] by done.
      move : (add_prelude_tt Hcssrem) => Htt. move : (add_prelude_ff Hcssrem) => Hff.
      move/andP : (enc_bits_splitmsb Htt Henc1) => [Henc1r Hencmsb1].
      move/andP : (enc_bits_splitmsb Htt Henc2) => [Henc2r Hencmsb2].
      have Hencmsb1nil : enc_bits E [::(splitmsl ls1).2] [::(splitmsb bs1).2] by rewrite enc_bits_cons Hencmsb1 enc_bits_nil.
      have Hencmsb2nil : enc_bits E [::(splitmsl ls2).2] [::(splitmsb bs2).2] by rewrite enc_bits_cons Hencmsb2 enc_bits_nil.
      move : (bit_blast_eq_correct Hbbeq Hszmsl12 Hencmsb1nil Hencmsb2nil Hcseq).
      rewrite (eqP Heqf).
      rewrite (add_prelude_enc_bit_is_not_true ([:: (splitmsb bs1).2] == [:: (splitmsb bs2).2]) Hcseq) Seqs.singleton_eq-/(msb bs1) -/(msb bs2).
      move/negP/eqP/eqP => Hmsb12. move : (Bool.not_true_is_false (msb bs1 == msb bs2) Hmsb12) => Hmsb12f.
      rewrite Hmsb12f orFb.
      move : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => Hencr.
      have Hszcprrem : size r_rem = size (copy (size r_rem) lit_ff) by rewrite size_nseq.
      move : (add_prelude_enc_bit_ff Hcssrem) => Hencff.
      move : (enc_bits_copy (size r_rem) Hencff) => Henccpff.
      move : (bit_blast_eq_correct Hbbeq2 Hszcprrem Hencr Henccpff Hcseq2).
      rewrite (eqP Heqf2) (add_prelude_enc_bit_is_not_true ((sremB bs1 bs2) == copy (size r_rem) false) Hcseq2).
      move/negP/eqP/eqP => HsremB. move : (Bool.not_true_is_false ((sremB bs1 bs2) == copy (size r_rem) false) HsremB) => HsremBnot0.
      move : (enc_bits_size Hencr) => Hszencr.
      rewrite -Hszencr HsremBnot0.
      generalize Hszencr. rewrite size_sremB -(enc_bits_size Henc1) Hsz12. move => Hszrrem.
      move/eqP : (eq_refl (addB (sremB bs1 bs2) bs2)) => Haddr.
      exact : (bit_blast_add_correct Hbbadd Hencr Henc2 Haddr Hcsadd Hszrrem).
    + rewrite/=. case => _ <- <-. move => Hsz12 Hgt02 Henc1 Henc2.
      rewrite 6!add_prelude_catrev /smodB. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq Hcsu]; move/andP : Hcsu => [Hcseq2 Hcsu]; move/andP : Hcsu => [Hcsor Hcsu]; move/andP : Hcsu => [Hcsnot Hcsu]; move/andP : Hcsu => [Hcsand Hcsadd2].
      have Hszmsl12 : size [:: (splitmsl ls1).2] = size [:: (splitmsl ls2).2] by done.
      move : (add_prelude_tt Hcssrem) => Htt. move : (add_prelude_ff Hcssrem) => Hff.
      move/andP : (enc_bits_splitmsb Htt Henc1) => [Henc1r Hencmsb1].
      move/andP : (enc_bits_splitmsb Htt Henc2) => [Henc2r Hencmsb2].
      have Hencmsb1nil : enc_bits E [::(splitmsl ls1).2] [::(splitmsb bs1).2] by rewrite enc_bits_cons Hencmsb1 enc_bits_nil.
      have Hencmsb2nil : enc_bits E [::(splitmsl ls2).2] [::(splitmsb bs2).2] by rewrite enc_bits_cons Hencmsb2 enc_bits_nil.
      move : (bit_blast_eq_correct Hbbeq Hszmsl12 Hencmsb1nil Hencmsb2nil Hcseq) => Henceqr.
      generalize Henceqr. rewrite (eqP Heqf).
      rewrite (add_prelude_enc_bit_is_not_true ([:: (splitmsb bs1).2] == [:: (splitmsb bs2).2]) Hcseq) Seqs.singleton_eq-/(msb bs1) -/(msb bs2).
      move/negP/eqP/eqP => Hmsb12. move : (Bool.not_true_is_false (msb bs1 == msb bs2) Hmsb12) => Hmsb12f.
      rewrite Hmsb12f orFb.
      move : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => Hencr.
      have Hszcprrem : size r_rem = size (copy (size r_rem) lit_ff) by rewrite size_nseq.
      move : (add_prelude_enc_bit_ff Hcssrem) => Hencff.
      move : (enc_bits_copy (size r_rem) Hencff) => Henccpff.
      move : (bit_blast_eq_correct Hbbeq2 Hszcprrem Hencr Henccpff Hcseq2) => Henceq2r.
      case HsremB0: (sremB bs1 bs2 == zeros (size (sremB bs1 bs2))).
      * move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsb12f (enc_bits_size Hencr) (eqP HsremB0) size_sremB size_zeros -/(zeros (size ls2)) eq_refl.
        have {1}-> : (size ls2 = size (copy (size ls2) true)) by rewrite size_nseq. rewrite or0B.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_ones. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB0.
        move => Hencand2r.
        have Haddr :(addB (zeros (size (sremB bs1 bs2))) (zeros (size bs2)) = zeros (size bs1)).
        rewrite size_sremB add0B unzip2_zip; first by rewrite -(enc_bits_size Henc2) -Hsz12 (enc_bits_size Henc1).
        by rewrite 2!size_zeros -(enc_bits_size Henc2) -Hsz12 (enc_bits_size Henc1).
        rewrite -(eqP HsremB0) in Haddr.
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2.
        rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
      * move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsb12f (enc_bits_size Hencr) HsremB0 -/(zeros (size ls2)).
        have {1}-> : (size ls2 = size (zeros (size ls2))) by rewrite size_nseq. rewrite or0B.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_zeros. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB1.
        move => Hencand2r.
        move/eqP : (eq_refl (addB  (sremB bs1 bs2) bs2)) => Haddr.
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
    + rewrite /=. case => _ <- <-. move => Hsz12 Hgt02 Henc1 Henc2.
      rewrite 6!add_prelude_catrev /smodB. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq Hcsu]; move/andP : Hcsu => [Hcseq2 Hcsu]; move/andP : Hcsu => [Hcsor Hcsu]; move/andP : Hcsu => [Hcsnot Hcsu]; move/andP : Hcsu => [Hcsand Hcsadd2].
      have Hszmsl12 : size [:: (splitmsl ls1).2] = size [:: (splitmsl ls2).2] by done.
      move : (add_prelude_tt Hcssrem) => Htt. move : (add_prelude_ff Hcssrem) => Hff.
      move/andP : (enc_bits_splitmsb Htt Henc1) => [Henc1r Hencmsb1].
      move/andP : (enc_bits_splitmsb Htt Henc2) => [Henc2r Hencmsb2].
      have Hencmsb1nil : enc_bits E [::(splitmsl ls1).2] [::(splitmsb bs1).2] by rewrite enc_bits_cons Hencmsb1 enc_bits_nil.
      have Hencmsb2nil : enc_bits E [::(splitmsl ls2).2] [::(splitmsb bs2).2] by rewrite enc_bits_cons Hencmsb2 enc_bits_nil.
      move : (bit_blast_eq_correct Hbbeq Hszmsl12 Hencmsb1nil Hencmsb2nil Hcseq) => Henceqr.
      have Hszcprrem : size r_rem = size (copy (size r_rem) lit_ff) by rewrite size_nseq.
      move : (add_prelude_enc_bit_ff Hcssrem) => Hencff.
      move : (enc_bits_copy (size r_rem) Hencff) => Henccpff.
      move : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => Hencr.
      move : (bit_blast_eq_correct Hbbeq2 Hszcprrem Hencr Henccpff Hcseq2) => Henceq2r.
      generalize Henceq2r.
      rewrite (eqP Heqf2) (add_prelude_enc_bit_is_not_true ((sremB bs1 bs2) == copy (size r_rem) false) Hcseq2). move => HsremB.
      generalize HsremB.
      move/negP/eqP/eqP => HsremB0. move : (Bool.not_true_is_false ((sremB bs1 bs2) == copy (size r_rem) false) HsremB0) => HsremB0f.
      rewrite (enc_bits_size Hencr) -/(zeros (size (sremB bs1 bs2))) in HsremB0f.
      rewrite HsremB0f orbF.
      case Hmsbeq : (msb bs1 == msb bs2).
      * move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsbeq (enc_bits_size Hencr) HsremB0f.
        have ->: (copy (size ls2) false = zeros (size (copy (size ls2) true))) by rewrite size_nseq.
        rewrite orB0.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_ones. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB0.
        move => Hencand2r.
        have Haddr :(addB  (sremB bs1 bs2) (zeros (size bs2)) = (sremB bs1 bs2)).
        rewrite addB0 unzip1_zip; first done.
        by rewrite size_sremB size_zeros -(enc_bits_size Henc2)-Hsz12 (enc_bits_size Henc1).
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
      * move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsbeq (enc_bits_size Hencr) HsremB0f.
        have {2}-> : copy (size ls2) false  = zeros (size (copy (size ls2) false)) by rewrite size_nseq.
        rewrite orB0.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_zeros. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB1.
        move => Hencand2r.
        move/eqP :(eq_refl (addB  (sremB bs1 bs2) bs2)) => Haddr.
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
    + rewrite /=. case => _ <- <-. move => Hsz12 Hgt02 Henc1 Henc2.
      rewrite 6!add_prelude_catrev /smodB. move/andP => [Hcssrem Hcsu]; move/andP : Hcsu => [Hcseq Hcsu]; move/andP : Hcsu => [Hcseq2 Hcsu]; move/andP : Hcsu => [Hcsor Hcsu]; move/andP : Hcsu => [Hcsnot Hcsu]; move/andP : Hcsu => [Hcsand Hcsadd2].
      have Hszmsl12 : size [:: (splitmsl ls1).2] = size [:: (splitmsl ls2).2] by done.
      move : (add_prelude_tt Hcssrem) => Htt. move : (add_prelude_ff Hcssrem) => Hff.
      move/andP : (enc_bits_splitmsb Htt Henc1) => [Henc1r Hencmsb1].
      move/andP : (enc_bits_splitmsb Htt Henc2) => [Henc2r Hencmsb2].
      have Hencmsb1nil : enc_bits E [::(splitmsl ls1).2] [::(splitmsb bs1).2] by rewrite enc_bits_cons Hencmsb1 enc_bits_nil.
      have Hencmsb2nil : enc_bits E [::(splitmsl ls2).2] [::(splitmsb bs2).2] by rewrite enc_bits_cons Hencmsb2 enc_bits_nil.
      move : (bit_blast_eq_correct Hbbeq Hszmsl12 Hencmsb1nil Hencmsb2nil Hcseq) => Henceqr.
      have Hszcprrem : size r_rem = size (copy (size r_rem) lit_ff) by rewrite size_nseq.
      move : (add_prelude_enc_bit_ff Hcssrem) => Hencff.
      move : (enc_bits_copy (size r_rem) Hencff) => Henccpff.
      move : (bit_blast_srem_correct Hbbsrem Hsz12 Hgt02 Henc1 Henc2 Hcssrem) => [Hencr].
      move : (bit_blast_eq_correct Hbbeq2 Hszcprrem Hencr Henccpff Hcseq2) => Henceq2r.
      case Hmsbeq : (msb bs1 == msb bs2); last case Hmsbeq2 : ((sremB bs1 bs2) == zeros (size (sremB bs1 bs2))).
      * rewrite/=.
        have Hszcpeq : (size (copy (size ls2) r_eq)= size (copy (size ls2) r_eq2)) by rewrite 2!size_nseq.
        move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        have {1}-> :(size ls2 = size (copy (size ls2) ((sremB bs1 bs2) == copy (size r_rem) false))) by rewrite size_nseq.
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsbeq (enc_bits_size Hencr).
        rewrite -/b1 -/(ones (size (copy (size ls2) ((sremB bs1 bs2) == copy (size (sremB bs1 bs2)) false)))) or1B size_nseq.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_ones. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand).
        rewrite (enc_bits_size Henc2) andB0.
        move => Hencand2r.
        have Haddr :(addB  (sremB bs1 bs2) (zeros (size bs2)) = (sremB bs1 bs2)).
        rewrite addB0 unzip1_zip; first done.
        by rewrite size_sremB -(enc_bits_size Henc2) -Hsz12 (enc_bits_size Henc1) size_zeros.
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
      * rewrite/=.
        have Hszcpeq : (size (copy (size ls2) r_eq)= size (copy (size ls2) r_eq2)) by rewrite 2!size_nseq.
        move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsbeq (enc_bits_size Hencr).
        rewrite /zeros in Hmsbeq2.
        have {1}->: (size ls2 = size (copy (size ls2) true)) by rewrite size_nseq.
        rewrite Hmsbeq2 -/b0 -/(zeros (size (copy (size ls2) true))) or0B -/b1 -/(ones (size ls2)).
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_ones. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB0.
        move => Hencand2r.
        have Haddr :(addB  (sremB bs1 bs2) (zeros (size bs2)) = (sremB bs1 bs2)).
        rewrite addB0 unzip1_zip; first done.
        by rewrite size_sremB size_zeros -(enc_bits_size Henc2)-Hsz12 (enc_bits_size Henc1).
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
      * rewrite/=.
        have Hszcpeq : (size (copy (size ls2) r_eq)= size (copy (size ls2) r_eq2)) by rewrite 2!size_nseq.
        move : (bit_blast_or_correct Hbbor (enc_bits_copy (size ls2) Henceqr) (enc_bits_copy (size ls2) Henceq2r) Hcsor).
        rewrite -/(msb bs1) -/(msb bs2) Seqs.singleton_eq Hmsbeq (enc_bits_size Hencr) Hmsbeq2.
        have {2} -> : (copy (size ls2) false = zeros (size (copy (size ls2) false))) by rewrite size_nseq.
        rewrite orB0.
        move => Hencorr.
        move : (bit_blast_not_correct Hbbnot Hencorr Hcsnot). rewrite invB_zeros. move => Hencnotr.
        move : (bit_blast_and_correct Hbband2 Henc2 Hencnotr Hcsand). rewrite (enc_bits_size Henc2) andB1.
        move => Hencand2r.
        have Haddr :(addB  (sremB bs1 bs2) bs2 = addB (sremB bs1 bs2) bs2) by done.
        move : (bit_blast_srem_size_ss Hbbsrem Hsz12) => Hszsrem.
        move : (bit_blast_or_size_ss Hbbor) => Hszor. rewrite !size_nseq in Hszor.
        move : (bit_blast_not_size_ss Hbbnot) => Hsznot. rewrite Hszor in Hsznot; last reflexivity.
        move : (bit_blast_and_size_ss Hbband2 Hsznot) => Hszand2. rewrite -Hsz12 -Hszsrem in Hszand2.
        exact : (bit_blast_add_correct Hbbadd2 Hencr Hencand2r Haddr Hcsadd2 Hszand2).
Qed.

Lemma bit_blast_smod_correct' g ls1 ls2 g' cs rlrs E bs1 bs2 :
  bit_blast_smod g ls1 ls2 = (g', cs, rlrs) ->
  size ls1 = size ls2 ->
  0 < size ls1 ->
  enc_bits E ls1 bs1 ->
  enc_bits E ls2 bs2 ->
  interp_cnf E (add_prelude cs) ->
  enc_bits E rlrs (smodB' bs1 bs2).
Proof.
  rewrite -smodB_is_smodB'. exact: bit_blast_smod_correct.
Qed.

Definition mk_env_smod E g ls1 ls2 : env * generator * cnf * word :=
  let (ls1_tl, ls1_sign) := eta_expand (splitmsl ls1) in
  let (ls2_tl, ls2_sign) := eta_expand (splitmsl ls2) in
  let '(E_srem, g_srem, cs_srem, lrs_srem) := mk_env_srem E g ls1 ls2 in
  let '(E_eq, g_eq, cs_eq, r_eq) := mk_env_eq E_srem g_srem (ls1_sign::nil) (ls2_sign::nil) in
  let '(E_eq2, g_eq2, cs_eq2, r_eq2) := mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff) in
  if (r_eq == lit_tt) || (r_eq2 == lit_tt) then
    (E_eq2, g_eq2, catrev cs_srem (catrev cs_eq2 cs_eq), lrs_srem)
  else if (r_eq == lit_ff) && (r_eq2 == lit_ff) then
    let '(E_add, g_add, cs_add, lrs_add) := mk_env_add E_eq2 g_eq2 lrs_srem ls2 in
    (E_add, g_add, catrev cs_srem (catrev cs_eq (catrev cs_eq2 cs_add)), lrs_add)
       else let '(E_or, g_or, cs_or, lrs_or) := mk_env_or E_eq2 g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2) in
            let '(E_not, g_not, cs_not, lrs_not) := mk_env_not E_or g_or lrs_or in
            let '(E_and2, g_and2, cs_and2, lrs_and2) := mk_env_and E_not g_not ls2 lrs_not in
            let '(E_add2, g_add2, cs_add2, lrs_add2) := mk_env_add E_and2 g_and2 lrs_srem lrs_and2 in
            (E_add2, g_add2, catrev cs_srem (catrev cs_eq (catrev cs_eq2 (catrev cs_or (catrev cs_not (catrev cs_and2 cs_add2))))), lrs_add2).

Lemma mk_env_smod_is_bit_blast_smod E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  bit_blast_smod g ls1 ls2  = (g', cs, lrs).
Proof.
  rewrite /mk_env_smod /bit_blast_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq] g_eq] cs_eq] lr_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))
  => [[[[E_eq2] g_eq2] cs_eq2] lr_eq2] Hmkeq2.
  rewrite (mk_env_srem_is_bit_blast_srem Hmksrem).
  rewrite (mk_env_eq_is_bit_blast_eq Hmkeq) (mk_env_eq_is_bit_blast_eq Hmkeq2).
  case ((lr_eq == lit_tt) || (lr_eq2 == lit_tt));
    last case ((lr_eq == lit_ff) && (lr_eq2 == lit_ff)).
  - by case=> _ <- <- <-.
  - dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    rewrite (mk_env_add_is_bit_blast_add Hmkadd). by case=> _ <- <- <-.
  - dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) lr_eq) (copy (size ls2) lr_eq2))
    => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not)
    => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    rewrite (mk_env_or_is_bit_blast_or Hmkor) (mk_env_not_is_bit_blast_not Hmknot)
      (mk_env_and_is_bit_blast_and Hmkand) (mk_env_add_is_bit_blast_add Hmkadd).
    by case=> _ <- <- <-.
Qed.

Lemma mk_env_smod_newer_gen E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  (g <=? g')%positive.
Proof.
  rewrite /mk_env_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq] g_eq] cs_eq] lr_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))
  => [[[[E_eq2] g_eq2] cs_eq2] lr_eq2] Hmkeq2.
  move: (mk_env_srem_newer_gen Hmksrem) => Hggsrem.
  move: (mk_env_eq_newer_gen Hmkeq) => Hgsremgeq.
  move: (mk_env_eq_newer_gen Hmkeq2) => Hgeqgeq2.
  case ((lr_eq == lit_tt) || (lr_eq2 == lit_tt));
    last case ((lr_eq == lit_ff) && (lr_eq2 == lit_ff)).
  - case=> _ <- _ _.
    exact: (pos_leb_trans Hggsrem (pos_leb_trans Hgsremgeq Hgeqgeq2)).
  - dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- _ _.
    move: (mk_env_add_newer_gen Hmkadd) => Hgeq2gadd.
    exact: (pos_leb_trans Hggsrem (pos_leb_trans Hgsremgeq
           (pos_leb_trans Hgeqgeq2 Hgeq2gadd))).
  - dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) lr_eq) (copy (size ls2) lr_eq2))
    => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not)
    => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- _ _.
    move: (mk_env_or_newer_gen Hmkor) => Hgeq2gor.
    move: (mk_env_not_newer_gen Hmknot) => Hgorgnot.
    move: (mk_env_and_newer_gen Hmkand) => Hgnotgand.
    move: (mk_env_add_newer_gen Hmkadd) => Hgandgadd.
    by apply (pos_leb_trans Hggsrem), (pos_leb_trans Hgsremgeq),
       (pos_leb_trans Hgeqgeq2), (pos_leb_trans Hgeq2gor), (pos_leb_trans Hgorgnot),
       (pos_leb_trans Hgnotgand).
Qed.

Lemma mk_env_smod_newer_res E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  newer_than_lit g lit_tt ->
  newer_than_lits g ls1 ->
  newer_than_lits g ls2 ->
  newer_than_lits g' lrs.
Proof.
  move=> Hmk Hgtt Hgls1 Hgls2. move: Hmk. rewrite /mk_env_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq] g_eq] cs_eq] lr_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))
  => [[[[E_eq2] g_eq2] cs_eq2] lr_eq2] Hmkeq2.
  case ((lr_eq == lit_tt) || (lr_eq2 == lit_tt));
    last case ((lr_eq == lit_ff) && (lr_eq2 == lit_ff)).
  - case=> _ <- _ <-.
    move: (mk_env_srem_newer_res Hmksrem Hgtt Hgls1 Hgls2) => Hgsremlsrem.
    move: (mk_env_eq_newer_gen Hmkeq) => Hgsremgeq.
    move: (mk_env_eq_newer_gen Hmkeq2) => Hgeqgeq2.
    exact: (newer_than_lits_le_newer Hgsremlsrem (pos_leb_trans Hgsremgeq Hgeqgeq2)).
  - dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- _ <-. exact: (mk_env_add_newer_res Hmkadd).
  - dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) lr_eq) (copy (size ls2) lr_eq2))
    => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not)
    => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- _ <-. exact: (mk_env_add_newer_res Hmkadd).
Qed.

Lemma mk_env_smod_newer_cnf E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  newer_than_lit g lit_tt ->
  newer_than_lits g ls1 ->
  newer_than_lits g ls2 ->
  newer_than_cnf g' cs.
Proof.
  move=> Hmk Hgtt Hgls1 Hgls2. move: Hmk. rewrite /mk_env_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq] g_eq] cs_eq] lr_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))
  => [[[[E_eq2] g_eq2] cs_eq2] lr_eq2] Hmkeq2.
  move: (mk_env_srem_newer_gen Hmksrem) => Hggsrem.
  move: (mk_env_eq_newer_gen Hmkeq) => Hgsremgeq.
  move: (mk_env_eq_newer_gen Hmkeq2) => Hgeqgeq2.
  move: (mk_env_srem_newer_cnf Hmksrem Hgtt Hgls1 Hgls2) => Hgsremcssrem.
  move: (newer_than_lit_le_newer Hgtt Hggsrem) => Hgsremtt.
  move: (newer_than_lits_le_newer Hgls1 Hggsrem) => Hgsremls1.
  move: (newer_than_lits_msl Hgsremtt Hgsremls1) => Hgsremmsl1.
  move: (newer_than_lits_copy 1 Hgsremmsl1) => Hgsrem1msl1.
  move: (newer_than_lits_le_newer Hgls2 Hggsrem) => Hgsremls2.
  move: (newer_than_lits_msl Hgsremtt Hgsremls2) => Hgsremmsl2.
  move: (newer_than_lits_copy 1 Hgsremmsl2) => Hgsrem1msl2.
  move: (mk_env_eq_newer_cnf Hmkeq Hgsremtt Hgsrem1msl1 Hgsrem1msl2) => Hgeqcseq.
  move: (newer_than_lit_le_newer Hgsremtt Hgsremgeq) => Hgeqtt.
  move: (mk_env_srem_newer_res Hmksrem Hgtt Hgls1 Hgls2) => Hgsremlsrem.
  move: (newer_than_lits_le_newer Hgsremlsrem Hgsremgeq) => Hgeqlsrem.
  rewrite newer_than_lit_tt_ff in Hgeqtt.
  move: (newer_than_lits_copy (size lrs_srem) Hgeqtt) => Hgeqcopy.
  move: (mk_env_eq_newer_cnf Hmkeq2 Hgeqtt Hgeqlsrem Hgeqcopy) => Hgeq2cseq2.
  move: (newer_than_cnf_le_newer Hgsremcssrem (pos_leb_trans Hgsremgeq Hgeqgeq2)) => Hgeq2cssrem.
  move: (newer_than_cnf_le_newer Hgeqcseq Hgeqgeq2) => Hgeq2cseq.
  case ((lr_eq == lit_tt) || (lr_eq2 == lit_tt));
    last case ((lr_eq == lit_ff) && (lr_eq2 == lit_ff)).
  - case=> _ <- <- _.
    by rewrite !newer_than_cnf_catrev Hgeq2cssrem Hgeq2cseq2 Hgeq2cseq.
  - dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- <- _.
    move: (newer_than_lits_le_newer Hgeqlsrem Hgeqgeq2) => Hgeq2lsrem.
    move: (newer_than_lits_le_newer Hgsremls2 (pos_leb_trans Hgsremgeq Hgeqgeq2)) => Hgeq2ls2.
    move: (newer_than_lit_le_newer Hgeqtt Hgeqgeq2) => Hgeq2tt.
    move: (mk_env_add_newer_cnf Hmkadd Hgeq2lsrem Hgeq2ls2 Hgeq2tt) => Hgaddcsadd.
    move: (mk_env_add_newer_gen Hmkadd) => Hgeq2gadd.
    move: (newer_than_cnf_le_newer Hgeq2cssrem Hgeq2gadd) => Hgaddcssrem.
    move: (newer_than_cnf_le_newer Hgeq2cseq Hgeq2gadd) => Hgaddcseq.
    move: (newer_than_cnf_le_newer Hgeq2cseq2 Hgeq2gadd) => Hgaddcseq2.
    by rewrite !newer_than_cnf_catrev Hgaddcssrem Hgaddcseq2 Hgaddcseq Hgaddcsadd.
  - dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) lr_eq) (copy (size ls2) lr_eq2))
    => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not)
    => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> _ <- <- _.
    move: (mk_env_or_newer_gen Hmkor) => Hgeq2gor.
    move: (mk_env_not_newer_gen Hmknot) => Hgorgnot.
    move: (mk_env_and_newer_gen Hmkand) => Hgnotgand.
    move: (mk_env_add_newer_gen Hmkadd) => Hgandgadd.
    move: (pos_leb_trans Hgnotgand Hgandgadd) => Hgnotgadd.
    move: (pos_leb_trans Hgorgnot Hgnotgadd) => Hgorgadd.
    move: (pos_leb_trans Hgeq2gor Hgorgadd) => Hgeq2gadd.
    move: (newer_than_cnf_le_newer Hgeq2cssrem Hgeq2gadd) => Hgaddcssrem.
    move: (newer_than_cnf_le_newer Hgeq2cseq Hgeq2gadd) => Hgaddcseq.
    move: (newer_than_cnf_le_newer Hgeq2cseq2 Hgeq2gadd) => Hgaddcseq2.
    move: (newer_than_lit_le_newer Hgeqtt Hgeqgeq2) => Hgeq2tt.
    rewrite -newer_than_lit_tt_ff in Hgeq2tt.
    move: (mk_env_eq_newer_res Hmkeq) => Hgeqleq.
    move: (newer_than_lit_le_newer Hgeqleq Hgeqgeq2) => Hgeq2leq.
    move: (newer_than_lits_copy (size ls2) Hgeq2leq) => Hgeq2leqs.
    move: (mk_env_eq_newer_res Hmkeq2) => Hgeq2leq2.
    move: (newer_than_lits_copy (size ls2) Hgeq2leq2) => Hgeq2leq2s.
    move: (mk_env_or_newer_cnf Hmkor Hgeq2tt Hgeq2leqs Hgeq2leq2s) => Hgorcsor.
    move: (newer_than_cnf_le_newer Hgorcsor Hgorgadd) => Hgaddcsor.
    move: (mk_env_or_newer_res Hmkor Hgeq2tt Hgeq2leqs Hgeq2leq2s) => Hgorlor.
    move: (mk_env_not_newer_cnf Hmknot Hgorlor) => Hgnotcsnot.
    move: (newer_than_cnf_le_newer Hgnotcsnot Hgnotgadd) => Hgaddcsnot.
    move: (newer_than_lit_le_newer Hgeq2tt (pos_leb_trans Hgeq2gor Hgorgnot)) => Hgnottt.
    move: (newer_than_lits_le_newer Hgsremls2 (pos_leb_trans Hgsremgeq
          (pos_leb_trans Hgeqgeq2 (pos_leb_trans Hgeq2gor Hgorgnot)))) => Hgnotls2.
    move: (mk_env_not_newer_res Hmknot Hgorlor) => Hgnotlnot.
    move: (mk_env_and_newer_cnf Hmkand Hgnottt Hgnotls2 Hgnotlnot) => Hgandcsand.
    move: (newer_than_cnf_le_newer Hgandcsand Hgandgadd) => Hgaddcsand.
    move: (newer_than_lits_le_newer Hgeqlsrem (pos_leb_trans Hgeqgeq2
          (pos_leb_trans Hgeq2gor (pos_leb_trans Hgorgnot Hgnotgand)))) => Hgandlsrem.
    move: (mk_env_and_newer_res Hmkand Hgnottt Hgnotls2 Hgnotlnot) => Hgandland.
    move: (newer_than_lit_le_newer Hgnottt Hgnotgand) => Hgandtt.
    rewrite newer_than_lit_tt_ff in Hgandtt.
    move: (mk_env_add_newer_cnf Hmkadd Hgandlsrem Hgandland Hgandtt) => Hgaddcsadd.
    by rewrite !newer_than_cnf_catrev Hgaddcssrem Hgaddcseq Hgaddcseq2 Hgaddcsor
               Hgaddcsnot Hgaddcsand Hgaddcsadd.
Qed.

Lemma mk_env_smod_preserve E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  env_preserve E E' g.
Proof.
  rewrite /mk_env_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq] g_eq] cs_eq] lr_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))
  => [[[[E_eq2] g_eq2] cs_eq2] lr_eq2] Hmkeq2.
  move: (mk_env_srem_newer_gen Hmksrem) => Hggsrem.
  move: (mk_env_eq_newer_gen Hmkeq) => Hgsremgeq.
  move: (mk_env_eq_newer_gen Hmkeq2) => Hgeqgeq2.
  move: (pos_leb_trans Hggsrem Hgsremgeq) => Hggeq.
  move: (pos_leb_trans Hggeq Hgeqgeq2) => Hggeq2.
  move: (mk_env_srem_preserve Hmksrem) => HEEsremg.
  move: (mk_env_eq_preserve Hmkeq) => HEsremEeqgsrem.
  move: (mk_env_eq_preserve Hmkeq2) => HEeqEeq2geq.
  move: (env_preserve_le HEsremEeqgsrem Hggsrem) => {HEsremEeqgsrem} HEsremEeqg.
  move: (env_preserve_le HEeqEeq2geq Hggeq) => {HEeqEeq2geq} HEeqEeq2g.
  move: (env_preserve_trans HEEsremg (env_preserve_trans HEsremEeqg HEeqEeq2g)) => HEEeq2g.
  case ((lr_eq == lit_tt) || (lr_eq2 == lit_tt));
    last case ((lr_eq == lit_ff) && (lr_eq2 == lit_ff)).
  - by case=> <- _ _ _.
  - dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> <- _ _ _.
    move: (mk_env_add_preserve Hmkadd) => HEeq2Eaddgeq2.
    move: (env_preserve_le HEeq2Eaddgeq2 Hggeq2) => {HEeq2Eaddgeq2} HEeq2Eaddg.
    by apply (env_preserve_trans HEEeq2g).
  - dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) lr_eq) (copy (size ls2) lr_eq2))
    => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not)
    => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and)
    => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case=> <- _ _ _.
    move: (mk_env_or_newer_gen Hmkor) => Hgeq2gor.
    move: (mk_env_not_newer_gen Hmknot) => Hgorgnot.
    move: (mk_env_and_newer_gen Hmkand) => Hgnotgand.
    move: (pos_leb_trans Hggeq2 Hgeq2gor) => Hggor.
    move: (pos_leb_trans Hggor Hgorgnot) => Hggnot.
    move: (pos_leb_trans Hggnot Hgnotgand) => Hggand.
    move: (mk_env_or_preserve Hmkor) => HEeq2Eorgeq2.
    move: (mk_env_not_preserve Hmknot) => HEorEnotgor.
    move: (mk_env_and_preserve Hmkand) => HEnotEandgnot.
    move: (mk_env_add_preserve Hmkadd) => HEandEaddgand.
    move: (env_preserve_le HEeq2Eorgeq2 Hggeq2) => {HEeq2Eorgeq2} HEeq2Eorg.
    move: (env_preserve_le HEorEnotgor Hggor) => {HEorEnotgor} HEorEnotg.
    move: (env_preserve_le HEnotEandgnot Hggnot) => {HEnotEandgnot} HEnotEandg.
    move: (env_preserve_le HEandEaddgand Hggand) => {HEandEaddgand} HEandEaddg.
    by apply (env_preserve_trans HEEeq2g), (env_preserve_trans HEeq2Eorg),
       (env_preserve_trans HEorEnotg), (env_preserve_trans HEnotEandg).
Qed.

Lemma mk_env_smod_sat E g ls1 ls2 E' g' cs lrs :
  mk_env_smod E g ls1 ls2 = (E', g', cs, lrs) ->
  newer_than_lit g lit_tt ->
  newer_than_lits g ls1 ->
  newer_than_lits g ls2 ->
  interp_cnf E' cs.
Proof.
  rewrite /mk_env_smod.
  dcase (mk_env_srem E g ls1 ls2) => [[[[E_srem] g_srem] cs_srem] lrs_srem] Hmksrem.
  dcase (mk_env_eq E_srem g_srem [:: (splitmsl ls1).2] [:: (splitmsl ls2).2]) => [[[[E_eq] g_eq] cs_eq] r_eq] Hmkeq.
  dcase (mk_env_eq E_eq g_eq lrs_srem (copy (size lrs_srem) lit_ff))  => [[[[E_eq2] g_eq2] cs_eq2] r_eq2] Hmkeq2.
    move : (mk_env_srem_newer_gen Hmksrem) => Hnewsrem.
    move : (mk_env_eq_newer_gen Hmkeq) => Hneweq.
    move : (mk_env_eq_newer_gen Hmkeq2) => Hneweq2.
  case Htt1 : (r_eq == lit_tt) ; case Hff1 : (r_eq == lit_ff); case Htt2 : (r_eq2 == lit_tt); case Hff2 : (r_eq2 == lit_ff);
    try rewrite (eqP Htt1)// in Hff1; try rewrite (eqP Htt2)// in Hff2.
  - rewrite /=. case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) .
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq//.
  - rewrite /=. case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq Hcnfeq2//.
  - rewrite /=. case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq Hcnfeq2//.
  - rewrite /=. case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq Hcnfeq2//.
  - rewrite /=.
    dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2) => [[[[E_add] g_add] cs_add] lrs_add] Hmkaddr.
    case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_newer_cnf Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcseq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkaddr) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq Hneweq2))).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkaddr) (newer_than_cnf_le_newer Hcseq Hneweq2)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkaddr) Hcseq2) Hcnfeq2.
    rewrite (mk_env_add_sat Hmkaddr (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq Hneweq2)) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))))//.
  - rewrite /=.
    dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2)) => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not ] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not) => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and) => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    move : (mk_env_eq_newer_res Hmkeq2) => Hgeq2.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewcp2 : (newer_than_lits g_eq (copy (size ls2) r_eq)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq).
    }
    have Hnewcp22 : (newer_than_lits g_eq2 (copy (size ls2) r_eq2)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq2).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_newer_cnf Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcseq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    move : (mk_env_or_newer_gen Hmkor) => Hnewor.
    move : (mk_env_or_newer_res Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hgor.
    move : (mk_env_or_sat Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcnfor.
    move : (mk_env_or_newer_cnf Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcsor.
    move : (mk_env_not_newer_gen Hmknot) => Hnewnot.
    move : (mk_env_not_newer_res Hmknot Hgor) => Hgnot.
    move : (mk_env_not_sat Hmknot Hgor) => Hcnfnot.
    move : (mk_env_not_newer_cnf Hmknot Hgor) => Hcsnot.
    move : (mk_env_and_newer_gen Hmkand) => Hnewand.
    move : (mk_env_and_newer_res Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hgand.
    move : (mk_env_and_newer_cnf Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcsand.
    move : (mk_env_and_sat Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcnfand.
    move : (mk_env_add_newer_gen Hmkadd) => Hnewadd.
    move : (mk_env_add_newer_res Hmkadd) => Hgadd.
    move : (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcnfadd.
    move : (mk_env_add_newer_cnf Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcsadd.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 Hnewor)))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq Hneweq2))).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot)))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 Hnewor))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcseq Hneweq2)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor Hnewnot))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq2 Hnewor)).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) Hcseq2) Hcnfeq2.
    rewrite (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))).
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsor (pos_leb_trans Hnewnot Hnewand))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcsor Hnewnot)).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) Hcsor) Hcnfor.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsnot Hnewand)).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) Hcsnot) Hcnfnot.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) Hcsand) Hcnfand//.
  - rewrite /=.
    dcase (mk_env_add E_eq2 g_eq2 lrs_srem ls2) => [[[[E_add] g_add] cs_add] lrs_add] Hmkaddr.
    case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_newer_cnf Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcseq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq Hcnfeq2//.
  - rewrite /=.
    dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2)) => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not ] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not) => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and) => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    move : (mk_env_eq_newer_res Hmkeq2) => Hgeq2.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewcp2 : (newer_than_lits g_eq (copy (size ls2) r_eq)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq).
    }
    have Hnewcp22 : (newer_than_lits g_eq2 (copy (size ls2) r_eq2)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq2).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_newer_cnf Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcseq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    move : (mk_env_or_newer_gen Hmkor) => Hnewor.
    move : (mk_env_or_newer_res Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hgor.
    move : (mk_env_or_sat Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcnfor.
    move : (mk_env_or_newer_cnf Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcsor.
    move : (mk_env_not_newer_gen Hmknot) => Hnewnot.
    move : (mk_env_not_newer_res Hmknot Hgor) => Hgnot.
    move : (mk_env_not_sat Hmknot Hgor) => Hcnfnot.
    move : (mk_env_not_newer_cnf Hmknot Hgor) => Hcsnot.
    move : (mk_env_and_newer_gen Hmkand) => Hnewand.
    move : (mk_env_and_newer_res Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hgand.
    move : (mk_env_and_newer_cnf Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcsand.
    move : (mk_env_and_sat Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcnfand.
    move : (mk_env_add_newer_gen Hmkadd) => Hnewadd.
    move : (mk_env_add_newer_res Hmkadd) => Hgadd.
    move : (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcnfadd.
    move : (mk_env_add_newer_cnf Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcsadd.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 Hnewor)))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq Hneweq2))).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot)))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 Hnewor))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcseq Hneweq2)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor Hnewnot))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq2 Hnewor)).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) Hcseq2) Hcnfeq2.
    rewrite (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))).
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsor (pos_leb_trans Hnewnot Hnewand))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcsor Hnewnot)).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) Hcsor) Hcnfor.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsnot Hnewand)).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) Hcsnot) Hcnfnot.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) Hcsand) Hcnfand//.
  - rewrite /=.
    dcase (mk_env_or E_eq2 g_eq2 (copy (size ls2) r_eq) (copy (size ls2) r_eq2)) => [[[[E_or] g_or] cs_or] lrs_or] Hmkor.
    dcase (mk_env_not E_or g_or lrs_or) => [[[[E_not] g_not] cs_not ] lrs_not] Hmknot.
    dcase (mk_env_and E_not g_not ls2 lrs_not) => [[[[E_and] g_and] cs_and] lrs_and] Hmkand.
    dcase (mk_env_add E_and g_and lrs_srem lrs_and) => [[[[E_add] g_add] cs_add] lrs_add] Hmkadd.
    case => <- _ <- _; move => Htt Hls1 Hls2; generalize Htt; rewrite newer_than_lit_tt_ff; move => Hff.
    rewrite !interp_cnf_catrev.
    move : (mk_env_srem_newer_res Hmksrem Htt Hls1 Hls2) => Hgsrem.
    move : (mk_env_srem_newer_cnf Hmksrem Htt Hls1 Hls2) => Hcssrem.
    move : (mk_env_srem_sat Hmksrem Htt Hls1 Hls2) => Hcnfsrem.
    move : (mk_env_eq_newer_res Hmkeq ) => Hgeq.
    move : (mk_env_eq_newer_res Hmkeq2) => Hgeq2.
    have Hnewcp : (newer_than_lits g (copy (size lrs_srem) lit_ff)).
    {
      exact : (newer_than_lits_copy (size lrs_srem) Hff).
    }
    have Hnewcp2 : (newer_than_lits g_eq (copy (size ls2) r_eq)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq).
    }
    have Hnewcp22 : (newer_than_lits g_eq2 (copy (size ls2) r_eq2)).
    {
      exact : (newer_than_lits_copy (size ls2) Hgeq2).
    }
    have Hnewmsl: (newer_than_lits g [:: (splitmsl ls1).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls1) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc).
    }
    have Hnewmsl2 : (newer_than_lits g [:: (splitmsl ls2).2]).
    {
      move/andP : (newer_than_lits_splitmsl Htt Hls2) => [_ Hnewc].
      exact : (newer_than_lits_copy 1 Hnewc) .
    }
    move : (mk_env_eq_sat Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcnfeq2.
    move : (mk_env_eq_newer_cnf Hmkeq2 (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem Hneweq)) (newer_than_lits_le_newer Hgsrem Hneweq) (newer_than_lits_le_newer Hnewcp (pos_leb_trans Hnewsrem Hneweq))) => Hcseq2.
    move : (mk_env_eq_sat Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcnfeq.
    move : (mk_env_eq_newer_cnf Hmkeq (newer_than_lit_le_newer Htt Hnewsrem) (newer_than_lits_le_newer Hnewmsl Hnewsrem) (newer_than_lits_le_newer Hnewmsl2 Hnewsrem)) => Hcseq.
    move : (mk_env_or_newer_gen Hmkor) => Hnewor.
    move : (mk_env_or_newer_res Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hgor.
    move : (mk_env_or_sat Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcnfor.
    move : (mk_env_or_newer_cnf Hmkor (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq Hneweq2))) (newer_than_lits_le_newer Hnewcp2 Hneweq2) Hnewcp22) => Hcsor.
    move : (mk_env_not_newer_gen Hmknot) => Hnewnot.
    move : (mk_env_not_newer_res Hmknot Hgor) => Hgnot.
    move : (mk_env_not_sat Hmknot Hgor) => Hcnfnot.
    move : (mk_env_not_newer_cnf Hmknot Hgor) => Hcsnot.
    move : (mk_env_and_newer_gen Hmkand) => Hnewand.
    move : (mk_env_and_newer_res Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hgand.
    move : (mk_env_and_newer_cnf Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcsand.
    move : (mk_env_and_sat Hmkand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) (newer_than_lits_le_newer Hls2 (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))) Hgnot) => Hcnfand.
    move : (mk_env_add_newer_gen Hmkadd) => Hnewadd.
    move : (mk_env_add_newer_res Hmkadd) => Hgadd.
    move : (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcnfadd.
    move : (mk_env_add_newer_cnf Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Hff (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))) => Hcsadd.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot))))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 Hnewor)))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcssrem (pos_leb_trans Hneweq Hneweq2))).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) (newer_than_cnf_le_newer Hcssrem Hneweq)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq) Hcssrem) Hcnfsrem.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor Hnewnot)))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq (pos_leb_trans Hneweq2 Hnewor))).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) (newer_than_cnf_le_newer Hcseq Hneweq2)).
    rewrite (env_preserve_cnf (mk_env_eq_preserve Hmkeq2) Hcseq) Hcnfeq.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand)))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcseq2 (pos_leb_trans Hnewor Hnewnot))).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) (newer_than_cnf_le_newer Hcseq2 Hnewor)).
    rewrite (env_preserve_cnf (mk_env_or_preserve Hmkor) Hcseq2) Hcnfeq2.
    rewrite (mk_env_add_sat Hmkadd (newer_than_lits_le_newer Hgsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))) Hgand (newer_than_lit_le_newer Htt (pos_leb_trans Hnewsrem (pos_leb_trans Hneweq (pos_leb_trans Hneweq2 (pos_leb_trans Hnewor (pos_leb_trans Hnewnot Hnewand))))))).
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsor (pos_leb_trans Hnewnot Hnewand))).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) (newer_than_cnf_le_newer Hcsor Hnewnot)).
    rewrite (env_preserve_cnf (mk_env_not_preserve Hmknot) Hcsor) Hcnfor.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) (newer_than_cnf_le_newer Hcsnot Hnewand)).
    rewrite (env_preserve_cnf (mk_env_and_preserve Hmkand) Hcsnot) Hcnfnot.
    rewrite (env_preserve_cnf (mk_env_add_preserve Hmkadd) Hcsand) Hcnfand//.
Qed.

Lemma mk_env_smod_env_equal E1 E2 g ls1 ls2 E1' E2' g1' g2' cs1 cs2 lrs1 lrs2 :
  env_equal E1 E2 ->
  mk_env_smod E1 g ls1 ls2 = (E1', g1', cs1, lrs1) ->
  mk_env_smod E2 g ls1 ls2 = (E2', g2', cs2, lrs2) ->
  env_equal E1' E2' /\ g1' = g2' /\ cs1 = cs2 /\ lrs1 = lrs2.
Proof.
  rewrite /mk_env_smod => Heq.
  dcase (mk_env_srem E1 g ls1 ls2) => [[[[E_srem1 g_srem1] cs_srem1] lrs_srem1] Hsrem1].
  dcase (mk_env_srem E2 g ls1 ls2) => [[[[E_srem2 g_srem2] cs_srem2] lrs_srem2] Hsrem2].
  move: (mk_env_srem_env_equal Heq Hsrem1 Hsrem2) => {Heq Hsrem1 Hsrem2} [Heq [? [? ?]]]; subst.
  dcase (mk_env_eq E_srem1 g_srem2 [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq1 g_eq1] cs_eq1] lrs_eq1] Heq1].
  dcase (mk_env_eq E_srem2 g_srem2 [:: (splitmsl ls1).2] [:: (splitmsl ls2).2])
  => [[[[E_eq2 g_eq2] cs_eq2] lrs_eq2] Heq2].
  move: (mk_env_eq_env_equal Heq Heq1 Heq2) => {Heq Heq1 Heq2} [Heq [? [? ?]]]; subst.
  dcase (mk_env_eq E_eq1 g_eq2 lrs_srem2 (copy (size lrs_srem2) lit_ff))
  => [[[[E_eq3 g_eq3] cs_eq3] lrs_eq3] Heq3].
  dcase (mk_env_eq E_eq2 g_eq2 lrs_srem2 (copy (size lrs_srem2) lit_ff))
  => [[[[E_eq4 g_eq4] cs_eq4] lrs_eq4] Heq4].
  move: (mk_env_eq_env_equal Heq Heq3 Heq4) => {Heq Heq3 Heq4} [Heq [? [? ?]]]; subst.
  case: ((lrs_eq2 == lit_tt) || (lrs_eq4 == lit_tt));
    last case: ((lrs_eq2 == lit_ff) && (lrs_eq4 == lit_ff)).
  - case=> ? ? ? ?; case=> ? ? ? ?; subst. done.
  - dcase (mk_env_add E_eq3 g_eq4 lrs_srem2 ls2)
    => [[[[E_add1 g_add1] cs_add1] lrs_add1] Hadd1].
    dcase (mk_env_add E_eq4 g_eq4 lrs_srem2 ls2)
    => [[[[E_add2 g_add2] cs_add2] lrs_add2] Hadd2].
    move: (mk_env_add_env_equal Heq Hadd1 Hadd2) => {Heq Hadd1 Hadd2} [Heq [? [? ?]]]; subst.
    case=> ? ? ? ?; case=> ? ? ? ?; subst. done.
  - dcase (mk_env_or E_eq3 g_eq4 (copy (size ls2) lrs_eq2) (copy (size ls2) lrs_eq4))
    => [[[[E_or1 g_or1] cs_or1] lrs_or1] Hor1].
    dcase (mk_env_or E_eq4 g_eq4 (copy (size ls2) lrs_eq2) (copy (size ls2) lrs_eq4))
    => [[[[E_or2 g_or2] cs_or2] lrs_or2] Hor2].
    move: (mk_env_or_env_equal Heq Hor1 Hor2) => {Heq Hor1 Hor2} [Heq [? [? ?]]]; subst.
    dcase (mk_env_not E_or1 g_or2 lrs_or2)
    => [[[[E_not1 g_not1] cs_not1] lrs_not1] Hnot1].
    dcase (mk_env_not E_or2 g_or2 lrs_or2)
    => [[[[E_not2 g_not2] cs_not2] lrs_not2] Hnot2].
    move: (mk_env_not_env_equal Heq Hnot1 Hnot2) => {Heq Hnot1 Hnot2} [Heq [? [? ?]]]; subst.
    dcase (mk_env_and E_not1 g_not2 ls2 lrs_not2)
    => [[[[E_and1 g_and1] cs_and1] lrs_and1] Hand1].
    dcase (mk_env_and E_not2 g_not2 ls2 lrs_not2)
    => [[[[E_and2 g_and2] cs_and2] lrs_and2] Hand2].
    move: (mk_env_and_env_equal Heq Hand1 Hand2) => {Heq Hand1 Hand2} [Heq [? [? ?]]]; subst.
    dcase (mk_env_add E_and1 g_and2 lrs_srem2 lrs_and2)
    => [[[[E_add1 g_add1] cs_add1] lrs_add1] Hadd1].
    dcase (mk_env_add E_and2 g_and2 lrs_srem2 lrs_and2)
    => [[[[E_add2 g_add2] cs_add2] lrs_add2] Hadd2].
    move: (mk_env_add_env_equal Heq Hadd1 Hadd2) => {Heq Hadd1 Hadd2} [Heq [? [? ?]]]; subst.
    case=> ? ? ? ?; case=> ? ? ? ?; subst. done.
Qed.


(* HoTT stuff required for categories *)
(* Borrowed from the other files over HoTT *)

Set Universe Polymorphism.
Set Nested Proofs Allowed.

Require Import Utf8.
Require Import funext.

Definition isSet (A : Type) := ∀ (a b : A) (p q : a = b), p = q.
Definition isProp (A : Type) := ∀ (x y : A), x = y.

Definition lu {A} {b c : A} (r : b = c) : r = eq_refl b • r :=
  hott_2_1_4_i_2 r.

Theorem hott_2_11_1 {A B} : ∀ (f : A → B), isequiv f → ∀ (a a' : A),
  (a = a') ≃ (f a = f a').
Proof.
intros f Hf a a'.
exists (@ap A B a a' f).
apply isequiv_qinv in Hf.
destruct Hf as (f₁, (α, β)).
apply qinv_isequiv.
unfold qinv.
set (g := λ r, (β a)⁻¹ • ap f₁ r • β a').
unfold "◦◦", id in g; simpl in g.
exists g; subst g.
unfold "◦◦", "∼", id; simpl.
split; intros q.
-set (r := @compose _ _ _ a' (@invert _ (f₁ (f a)) a (β a) • ap f₁ q) (β a')).
 apply (@compose _ _ ((α (f a))⁻¹ • α (f a) • ap f r)).
 +eapply compose; [ apply lu | idtac ].
  apply dotr, invert, compose_invert_l.
 +eapply compose; [ eapply invert, compose_assoc | idtac ].
  unfold id, composite; simpl.
  pose proof (hott_2_4_3 ((f ◦◦ f₁) ◦◦ f) f (λ a, α (f a)) r) as H.
  unfold "◦◦" in H; simpl in H.
  eapply compose; [ eapply dotl, H | simpl ].
  apply (@compose _ _ ((α (f a))⁻¹ • (ap f (ap f₁ (ap f r)) • α (f a')))).
  *apply dotl, dotr.
   apply (@compose _ _ (ap (f ◦◦ f₁ ◦◦ f) r)); [ reflexivity | idtac ].
   eapply invert, compose; [ idtac | eapply ap_composite ].
   eapply compose; [ apply (ap_composite f₁ f (ap f r)) | reflexivity ].
  *eapply compose; [ apply compose_assoc | idtac ].
   rewrite (ap_composite f f₁ r).
   apply (@compose _ _ ((α (f a))⁻¹ • ap f (β a • r • (β a')⁻¹) • α (f a'))).
  --apply dotr, dotl, ap.
    rewrite r; simpl.
    rewrite <- ru, compose_invert_r.
    reflexivity.
  --apply (@compose _ _ ((α (f a))⁻¹ • ap f (ap f₁ q) • α (f a'))).
   **apply dotr, dotl, ap; subst r.
     do 2 rewrite compose_assoc.
     rewrite compose_invert_r; simpl.
     unfold id; simpl.
     rewrite <- compose_assoc.
     rewrite compose_invert_r; simpl.
     rewrite <- ru; reflexivity.
   **assert (H1 : α (f a) • q = ap (f ◦◦ f₁) q • α (f a')). {
       rewrite <- (hott_2_4_3 (f ◦◦ f₁) id α q).
       apply dotl, invert, hott_2_2_2_iv.
     }
     unfold id, composite; simpl.
     pose proof (@ap_composite B A B (f a) (f a') f₁ f q) as H2.
     rewrite H2.
     rewrite <- compose_assoc.
     unfold id, composite in H1; simpl in H1.
     unfold composite; simpl.
     rewrite <- H1.
     rewrite compose_assoc, compose_invert_l.
     reflexivity.
-rewrite (ap_composite f f₁ q).
 destruct q; simpl.
 unfold "◦◦", "∼", id in β; simpl in β.
 unfold "◦◦"; simpl; rewrite β; reflexivity.
Defined.

Definition quasi_inv {A B} : A ≃ B → B ≃ A :=
  λ eqf,
  match eqf with
  | existT _ f (existT _ g Hg, existT _ h Hh) =>
      existT isequiv g
        (existT _ f (λ x, (Hh (g (f x)))⁻¹ • ap h (Hg (f x)) • Hh x),
         existT _ f Hg)
 end.

Fixpoint isnType (A : Type) n : Type :=
  match n with
  | 0 => isProp A
  | S p' => ∀ x y : A, isnType (x = y) p'
  end.

Theorem compose_cancel_l {A} {x y z : A} (p : x = y) (q r : y = z) :
  compose p q = compose p r → q = r.
Proof. intros; now destruct p. Qed.

(*
Theorem compose_eq_refl : ∀ A (x : A) (p : x = x), compose p eq_refl = p.
Proof. now intros; destruct p. Qed.

Theorem isContr_isProp {A} : isContr A → isProp A.
Proof.
intros f x y.
destruct f as (a & Ha).
apply @compose with (y := a); [ now destruct (Ha x) | now apply Ha ].
Qed.
*)

Theorem isProp_isSet {A} : isProp A → isSet A.
Proof.
intros f x y p q.
apply (compose_cancel_l (f x x)).
apply @compose with (y := f x y); [ now destruct p, (f x x) | ].
now destruct p, q, (f x x).
Qed.

(*
Theorem isnType_isSnType {A} n : isnType A n → isnType A (S n).
Proof.
intros * f.
revert A f.
induction n; intros; [ intros x y p q; now apply isProp_isSet | ].
intros p q.
apply IHn, f.
Qed.
*)

(*
Theorem equiv_eq : ∀ A B (f : A → B) (g : B → A) x y,
  (∀ b, f (g b) = b) → g x = g y → x = y.
Proof.
intros * Hfg H.
apply @compose with (y := f (g y)); [ | apply Hfg ].
destruct H; symmetry; apply Hfg.
Defined.
*)

Lemma isnType_if_equiv : ∀ A B n, A ≃ B → isnType A n → isnType B n.
Proof.
intros * HAB HA.
revert A B HAB HA.
induction n; intros. {
  destruct HAB as (f, Hf).
  destruct Hf as ((g, Hfg), (h, Hhf)).
  move h before g.
  unfold id, "◦◦", "∼" in Hfg, Hhf.
  cbn in HA |-*.
  unfold isProp in HA |-*.
  intros x y.
  rewrite <- Hfg; symmetry.
  rewrite <- Hfg; symmetry.
  f_equal.
  apply HA.
}
destruct HAB as (f, Hf).
destruct Hf as ((g, Hfg), (h, Hhf)).
cbn in HA |-*.
move h before g.
unfold id, "◦◦", "∼" in Hfg, Hhf.
intros x y.
apply (IHn (g x = g y) (x = y)); [ | apply HA ].
apply quasi_inv.
apply hott_2_11_1.
split.
-exists f.
 unfold "◦◦", "∼", id.
 intros z.
 rewrite <- Hhf.
 clear - Hfg Hhf.
 f_equal. (* bizarre que ça marche *)
-exists f.
 unfold "◦◦", "∼", id.
 apply Hfg.
Qed.

Theorem pair_transport_eq_existT {A} {P : A → Type} :
  ∀ a b (Ha : P a) (Hb : P b),
  {p : a = b & transport P p Ha = Hb} → existT P a Ha = existT P b Hb.
Proof.
intros * (p, Hp).
now destruct p, Hp.
Defined.

Theorem eq_existT_pair_transport {A} {P : A → Type} :
  ∀ a b (Ha : P a) (Hb : P b),
  existT P a Ha = existT P b Hb → {p : a = b & transport P p Ha = Hb}.
Proof.
intros * Hee.
inversion_sigma.
destruct Hee1.
now exists eq_refl.
Defined.

Theorem pair_transport_equiv_eq_existT {A : Type} : ∀ (P : A → Type),
  (∀ x, isProp (P x))
  → ∀ a b (Ha : P a) (Hb : P b),
  {p : a = b & transport P p Ha = Hb} ≃ (existT P a Ha = existT P b Hb).
Proof.
intros.
unfold "≃".
exists (pair_transport_eq_existT a b Ha Hb).
split. {
  exists (eq_existT_pair_transport a b Ha Hb).
  unfold "◦◦", "∼", id.
  intros p.
  inversion_sigma.
  destruct p1.
  cbn in p2; cbn.
  now destruct p2.
}
exists (eq_existT_pair_transport a b Ha Hb).
unfold "◦◦", "∼", id.
intros (p, Hp).
now destruct p, Hp.
Qed.

(*
Theorem transport_pair : ∀ A B C (x y : A) (p : x = y) b c,
  transport (λ z, (B z * C z)%type) p (b, c) =
  (transport B p b, transport C p c).
Proof.
intros.
destruct p; reflexivity.
Qed.
*)

Theorem isnType_isnType_sigT (A : Type) : ∀ n (P : A → Type),
  (∀ x, isProp (P x)) → isnType A n → isnType (@sigT A P) n.
Proof.
intros * HP Hn.
revert A P HP Hn.
induction n; intros. {
  cbn in Hn; cbn.
  unfold isProp in Hn |-*.
  intros H1 H2.
  destruct H1 as (a & Ha).
  destruct H2 as (b & Hb).
  move b before a.
  apply eq_existT_uncurried.
  assert (p : a = b) by apply Hn.
  exists p.
  apply HP.
}
intros Ha Hb.
destruct Ha as (a, Ha).
destruct Hb as (b, Hb).
move b before a.
specialize (IHn (a = b)) as H4.
remember (λ p : a = b, transport P p Ha = Hb) as Q.
specialize (H4 Q).
assert (H : ∀ p : a = b, isProp (Q p)). {
  intros p.
  subst Q.
  destruct p.
  cbn.
  specialize (HP a) as H1.
  specialize (isProp_isSet H1 Ha Hb) as H2.
  intros r s.
  apply H2.
}
specialize (H4 H); clear H.
cbn in Hn.
specialize (H4 (Hn a b)).
subst Q.
eapply isnType_if_equiv; [ | apply H4 ].
now apply pair_transport_equiv_eq_existT.
Qed.

Theorem isSet_isSet_sigT {A : Set} {P : A → Set} :
  (∀ x, isProp (P x)) → isSet A → isSet (@sigT A P).
Proof.
intros * HP HS.
now apply (isnType_isnType_sigT A 1 P).
Qed.

(*
Theorem isProp_isProp_sigT {A} {P : A → Type} :
  (∀ x, isProp (P x)) → isProp A → isProp (@sigT A P).
Proof.
intros * HP HS.
now apply (isnType_isnType_sigT A 0 P).
Qed.
*)

Axiom extensionality : ∀ {A B} f g, isequiv (@happly A B f g).

Definition funext {A B} {f g : Π (x : A), B x}
  : (∀ x : A, f x = g x) → f = g
  := λ p,
     match isequiv_qinv (happly f g) (extensionality f g) with
     | existT _ h _ => h p
     end.

Theorem funext_prop_uniq_princ {A B} : ∀ (f g : Π (x : A), B x) (p : f = g),
  p = funext (happly f g p).
Proof.
intros.
unfold funext; simpl.
set (q := isequiv_qinv (happly f g) (extensionality f g)).
destruct q as (k, (α, β)).
apply invert, β.
Defined.

Theorem hott_2_6_1 {A B} : ∀ x y : A * B,
  (x = y) → (fst x = fst y) * (snd x = snd y).
Proof.
intros x y p.
split; destruct p; reflexivity.
Defined.

Theorem pair_eq {A B} {x y : A * B} :
  (fst x = fst y) * (snd x = snd y) → (x = y).
Proof.
intros p.
destruct x as (a, b).
destruct y as (a', b').
simpl in p.
destruct p as (p, q).
destruct p, q; reflexivity.
Defined.

Theorem hott_2_6_2 {A B : Type} : ∀ x y : (A * B)%type,
  ((fst x = fst y) * (snd x = snd y))%type ≃ (x = y).
Proof.
intros.
set (f := hott_2_6_1 x y).
set (g := @pair_eq A B x y).
apply quasi_inv.
unfold "≃".
apply existT with (x := f).
apply qinv_isequiv.
exists g; split.
 intros r; unfold id; simpl.
 destruct r as (p, q).
 destruct x as (a, b).
 destruct y as (a', b').
 simpl in p, q, f, g.
 destruct p, q; reflexivity.

 intros p; unfold id; simpl.
 destruct p, x; reflexivity.
Qed.

Definition isSet_pair {A B} : isSet A → isSet B → isSet (A * B).
Proof.
intros r s x y p q.
pose proof hott_2_6_2 x y as e.
destruct x as (xa, xb).
destruct y as (ya, yb); simpl in e.
apply quasi_inv in e.
destruct e as (f, ((g, Hg), (h, Hh))).
unfold "◦◦", "∼", id in Hg, Hh.
pose proof Hh p as Hhp.
pose proof Hh q as Hhq.
destruct (f p) as (fpa, fpb).
destruct (f q) as (fqa, fqb).
pose proof r xa ya fpa fqa as Hra.
pose proof s xb yb fpb fqb as Hrb.
destruct Hra, Hrb.
unfold id in Hhp, Hhq.
destruct Hhp; assumption.
Defined.

Definition isSet_forall A B :
  (Π (a : A), isSet (B a)) → isSet (Π (a : A), B a).
Proof.
intros r f g p q.
unfold isSet in r.
pose proof funext_prop_uniq_princ f g p as Hp.
pose proof funext_prop_uniq_princ f g q as Hq.
assert (∀ x : A, happly _ _ p x = happly _ _ q x) as Hx by (intros; apply r).
apply funext in Hx.
rewrite Hp, Hq, Hx.
reflexivity.
Defined.

(*
Notation "⊥" := False.
*)

Definition Σ_pr₁ {A B} (x : { y : A & B y }) : A :=
  match x with existT _ a _ => a end.
Definition Σ_pr₂ {A B} (x : { y : A & B y }) : B (Σ_pr₁ x) :=
  match x with existT _ _ b => b end.

(*
Module Σ_type.
*)

Definition pr₁ {A B} := @Σ_pr₁ A B.
Definition pr₂ {A B} := @Σ_pr₂ A B.

(*
End Σ_type.

(* "3.7 Propositional truncation" *)

Axiom PT : Type → Type.
Arguments PT _%type.
Notation "∥ A ∥" := (PT A) (A at level 0, format "∥ A ∥") : type_scope.

Axiom PT_intro : ∀ A, A → ∥A∥.
Arguments PT_intro [A] x.
Notation "╎ A ╎" := (PT_intro A) (A at level 0, format "╎ A ╎") : type_scope.

Axiom PT_eq : ∀ A, isProp ∥A∥.
(* Arguments PT_eq [A] x y. *)

(* "If B is a mere proposition and we have f : A → B, then there is an
    induced g : ∥A∥ → B such that g(|a|) ≡ f(a) for all a : A." *)

Axiom PT_rec : ∀ A B (f : A → B), isProp B →
  Σ (g : ∥A∥ → B), ∀ a, g (PT_intro a) = f a.

Definition PT_elim {A} : isProp A → ∥A∥ → A :=
  λ PA, Σ_type.pr₁ (PT_rec A A id PA).
Definition PT_intro_not {A} : notT A → notT ∥A∥ :=
  λ f, Σ_type.pr₁ (PT_rec A ⊥ f (λ x y : ⊥, match x with end)).
*)

Theorem isSet_True : isSet True.
Proof.
apply isProp_isSet.
now intros x y; destruct x, y.
Qed.

Theorem isSet_False : isSet False.
Proof.
apply isProp_isSet.
now intros x y; destruct x, y.
Qed.

(*
Theorem univalence : ∀ A B : Type, (A ≃ B) ≃ (A = B).
Proof.
intros.
pose proof (@univ A B) as p.
apply quasi_inv.
esplit; eassumption.
Defined.
*)

(*
Definition eqv_refl A : A ≃ A.
Proof.
exists id; apply qinv_isequiv; exists  id.
split; intros a; apply eq_refl.
Defined.
*)

(*
Definition ua_idtoeqv {A B} : ∀ (p : A = B), ua (idtoeqv p) = p.
Proof.
intros.
unfold ua; simpl.
set (q := isequiv_qinv idtoeqv (univ A B)).
destruct q as (f, (α, β)).
apply β.
Defined.
*)

(*
Notation "'Σ' ( x : A ) , B" :=
  ({ x : A & B }) (at level 0, x at level 0, B at level 100, only parsing).
Notation "'Π' ( x : A ) , B" :=
  (∀ x : A, B) (at level 0, x at level 0, B at level 100, only parsing).
*)

(*
Definition ex_2_10 {A B C} :
  (Σ (x : A), Σ (y : B x), C (existT _ x y)) ≃ (Σ (p : Σ (x : A), B x), C p).
Proof.
exists
  (λ xyf,
   match xyf with
   | existT _ x (existT _ y f) => existT C (existT B x y) f
   end).
apply qinv_isequiv.
exists
  (λ xyf : {p : {x : A & B x} & C p},
   match xyf with
   | existT _ (existT _ x y) f =>
       (λ f : C (existT B x y), existT _ x (existT _ y f)) f
   end).
unfold "◦◦", "∼", id; simpl.
split; [ intros ((x, y), f) | intros (x, (y, f)) ]; reflexivity.
Defined.
*)

(*
Definition ua_pup {A B}
  : ∀ (p : A = B),
    p = ua (existT isequiv (transport id p) (isequiv_transport p))
  := λ (p : A = B),
     match p return
       (ua (idtoeqv p) = p
        → p = ua (existT isequiv (transport id p) (isequiv_transport p)))
     with
     | eq_refl _ =>
         λ q,
         match q in (_ = r) return (r = ua (eqv_refl A)) with
         | eq_refl _ => eq_refl _
         end
     end (ua_idtoeqv p).

Definition weak_funext A P :=
  (Π (x : A), isContr (P x)) → isContr (Π (x : A), P x).
Definition weak_funext1 A P :=
  (∀ x : A, {a : P x & ∀ y : P x, a = y}) → {a : ∀ x : A, P x & ∀ y : ∀ x : A, P x, a = y}.
*)

(*
Definition isContr_sigma_if A P :
  isContr A → (∀ x, isContr (P x)) → isContr (Σ (x : A), P x).
Proof.
intros p q.
unfold isContr.
destruct p as (a, p).
exists (existT _ a (Σ_pr₁ (q a))); intros (x, r).
apply (Σ_type_pair_eq (p x)).
destruct (p x); simpl.
destruct (q a) as (s, t); apply t.
Defined.
*)

(*
Definition pr₁ {A B} := @Σ_pr₁ A B.
Definition pr₂ {A B} := @Σ_pr₂ A B.
*)

(*
Definition isContr_fib_4_9_3 A (P : A → Type) (p : Π (x : A), isContr (P x)) :
  isContr (fib (Σ_pr₁ (hott_4_9_3 A P p)) id).
Proof.
apply hott_4_2_6.
apply hott_4_2_3.
set (q := hott_4_9_3 A P p).
destruct q as (f, q).
apply isequiv_qinv, q.
Defined.

Definition hott_3_11_3_i_ii A : isContr A → isProp A * Σ (a : A), True.
Proof.
intros p.
split; [ apply isContr_isProp; assumption | ].
destruct p as (a, p).
exists a; constructor.
Defined.

Definition hott_3_3_2 P : isProp P → ∀ x₀ : P, P ≃ True
:=
  λ (HP : isProp P) (x₀ : P),
  existT isequiv (λ _, I)
    (qinv_isequiv (λ _, I)
       (existT _ (λ _, x₀)
          (λ x, match x with I => eq_refl (id I) end,  λ x, HP _ x))).

Definition hott_3_11_3_ii_iii A : isProp A * (Σ (a : A), True) → A ≃ True.
Proof.
intros (p, (a, _)).
apply hott_3_3_2; assumption.
Defined.

Definition quasi_inv_l_eq_r {A B} (f : A → B) (g h : B → A) :
  f ◦◦ g ∼ id
  → h ◦◦ f ∼ id
  → g ∼ h
:=
  λ Hfg Hhf x, (Hhf (g x))⁻¹ • ap h (Hfg x).

Definition EqStr_equiv_fun {A B} : A ≃ B
  → Σ (f : A → B), Σ (g : B → A), (∀ x, g (f x) = x) ∧ (∀ y, f (g y) = y).
Proof.
intros p.
destruct p as (f, ((g, Hg), (h, Hh))).
exists f, g.
split; [ intros x | intros y; apply Hg ].
pose proof quasi_inv_l_eq_r f g h Hg Hh as p.
unfold "∼" in p.
etransitivity; [ apply p | apply Hh ].
Defined.

Definition hott_3_11_3_iii_i A : A ≃ True → isContr A.
Proof.
intros p.
apply EqStr_equiv_fun in p.
destruct p as (f, (g, (Hg, Hh))).
exists (g I); intros x.
etransitivity; [ | apply Hg ].
destruct (f x); reflexivity.
Defined.

Definition equiv_contr {A B} : A ≃ B → isContr A → isContr B.
Proof.
intros p q.
apply hott_3_11_3_i_ii, hott_3_11_3_ii_iii in q.
apply quasi_inv in p.
eapply equiv_compose in q; [ | apply p ].
apply hott_3_11_3_iii_i; assumption.
Defined.
*)


(* ------------------------------------------------------------------------- *)
(** Displayed modifications.
    Contents:
      - Definition of displayed pseudofunctors.
      - Identity and composition of displayed pseudofunctors.                *)
(* ------------------------------------------------------------------------- *)

Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.
Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.Functors.
Require Import UniMath.CategoryTheory.DisplayedCats.Core.
Require Import UniMath.CategoryTheory.DisplayedCats.Constructions.
Require Import UniMath.Bicategories.Core.Bicat. Import Bicat.Notations.
Require Import UniMath.Bicategories.Core.Examples.Initial.
Require Import UniMath.Bicategories.Core.Examples.Final.
Require Import UniMath.Bicategories.DisplayedBicats.DispBicat. Import DispBicat.Notations.
Require Import UniMath.Bicategories.Core.Univalence.
Require Import UniMath.Bicategories.Core.Invertible_2cells.
Require Import UniMath.Bicategories.DisplayedBicats.DispInvertibles.
Require Import UniMath.Bicategories.DisplayedBicats.DispAdjunctions.
Require Import UniMath.Bicategories.DisplayedBicats.DispUnivalence.
Require Import UniMath.Bicategories.PseudoFunctors.Display.PseudoFunctorBicat.
Require Import UniMath.Bicategories.PseudoFunctors.PseudoFunctor.
Require Import UniMath.Bicategories.PseudoFunctors.Examples.Identity.
Require Import UniMath.Bicategories.PseudoFunctors.Examples.Composition.
Require Import UniMath.Bicategories.Transformations.PseudoTransformation.
Require Import UniMath.Bicategories.Modifications.Modification.
Require Import UniMath.Bicategories.DisplayedBicats.DispPseudofunctor.
Require Import UniMath.Bicategories.DisplayedBicats.DispTransformation.

Import PseudoFunctor.Notations.

Local Open Scope cat.

(** ** Definition of displayed modifications *)

Section DispModification.

Context {B₁ : bicat} {D₁ : disp_bicat B₁}
        {B₂ : bicat} {D₂ : disp_bicat B₂}
        {F₁ F₂ : psfunctor B₁ B₂}
        (α β : pstrans F₁ F₂)
        (FF₁ : disp_psfunctor D₁ D₂ F₁)
        (FF₂ : disp_psfunctor D₁ D₂ F₂)
        (αα : disp_pstrans FF₁ FF₂ α)
        (ββ : disp_pstrans FF₁ FF₂ β)
        (m : modification α β).

(** *** Data *)

Definition disp_modification_data : UU
  := ∏ (x : B₁) (xx : D₁ x), (αα x xx) ==>[m x] (ββ x xx).

Definition total_modification_data (mmdata : disp_modification_data)
  : modification_data (total_pstrans _ _ _ αα) (total_pstrans _ _ _ ββ)
  := λ (x : total_bicat D₁), m (pr1 x),, mmdata (pr1 x) (pr2 x).

Definition is_disp_modification (mm : disp_modification_data) : UU
  := ∏ (x y : B₁) (f : B₁ ⟦ x, y ⟧)
       (xx : D₁ x) (yy : D₁ y) (ff : xx -->[ f] yy),
     disp_psnaturality_of FF₁ FF₂ α αα ff
       •• (disp_psfunctor_mor D₁ D₂ F₁ FF₁ ff ◃◃ mm y yy) =
     transportb
       (λ p, _ ==>[p] _)
       (modnaturality_of m x y f)
       ((mm x xx ▹▹ disp_psfunctor_mor D₁ D₂ F₂ FF₂ ff)
          •• disp_psnaturality_of FF₁ FF₂ β ββ ff).

Definition disp_modification : UU
  := ∑ mm : disp_modification_data, is_disp_modification mm.

Coercion disp_modification_to_disp_modification_data (αα : disp_modification)
  : disp_modification_data
  := pr1 αα.

Lemma is_disp_modification_from_total (mm : disp_modification_data)
  : is_modification (total_modification_data mm) → is_disp_modification mm.
Proof.
  intros Hmm.
  pose (Em := make_modification _ Hmm).
  intros x y f xx yy ff.
  pose (P := !fiber_paths (@modnaturality_of _ _ _ _ _ _ Em (x,,xx) (y,,yy) (f,,ff))).
  symmetry.
  etrans. { apply maponpaths. exact P. }
  unfold transportb.
  rewrite transport_f_f.
  rewrite transportf_set.
  * apply idpath.
  * apply B₂.
Qed.

Lemma total_modification_laws (mm : disp_modification)
  : is_modification (total_modification_data mm).
Proof.
  intros x y f.
  use total2_paths_b.
  - apply (modnaturality_of m (pr1 x) (pr1 y) (pr1 f)).
  - apply mm.
Qed.

Definition is_invertible_disp_modification (mm : disp_modification) : UU
  := ∑ (m_inv : is_invertible_modification m), ∏ (x : B₁) (xx : D₁ x),
       (* Each underlying displayed 2-cell is invertible *)
       is_disp_invertible_2cell (@is_invertible_modcomponent_of _ _ _ _ _ _ m m_inv x) (pr1 mm x xx).

End DispModification.

(** Invertible displayed modifications *)

Section DispInvModification.

Context {B₁ : bicat} {D₁ : disp_bicat B₁}
        {B₂ : bicat} {D₂ : disp_bicat B₂}
        {F₁ F₂ : psfunctor B₁ B₂}
        (α β : pstrans F₁ F₂)
        (FF₁ : disp_psfunctor D₁ D₂ F₁)
        (FF₂ : disp_psfunctor D₁ D₂ F₂)
        (αα : disp_pstrans FF₁ FF₂ α)
        (ββ : disp_pstrans FF₁ FF₂ β)
        (m : invertible_modification α β).

(** *** Data *)

Definition disp_invmodification_data : UU
  := ∏ (x : B₁) (xx : D₁ x),
     disp_invertible_2cell (invertible_modcomponent_of m x) (αα x xx) (ββ x xx).

Definition total_invmodification_data (mmdata : disp_invmodification_data)
  : invertible_modification_data (total_pstrans _ _ _ αα) (total_pstrans _ _ _ ββ)
  := λ (x : total_bicat D₁),
     (iso_in_E_weq (αα (pr1 x) (pr2 x)) (ββ (pr1 x) (pr2 x)))
       (invertible_modcomponent_of m (pr1 x),, mmdata (pr1 x) (pr2 x)).

Definition is_disp_invmodification (mm : disp_invmodification_data) : UU
  := ∏ (x y : B₁) (f : B₁ ⟦ x, y ⟧)
       (xx : D₁ x) (yy : D₁ y) (ff : xx -->[ f] yy),
     disp_psnaturality_of FF₁ FF₂ α αα ff
       •• (disp_psfunctor_mor D₁ D₂ F₁ FF₁ ff ◃◃ mm y yy) =
     transportb
       (λ p, _ ==>[p] _)
       (modnaturality_of (pr1 m) x y f)
       ((mm x xx ▹▹ disp_psfunctor_mor D₁ D₂ F₂ FF₂ ff)
          •• disp_psnaturality_of FF₁ FF₂ β ββ ff).

Definition disp_invmodification : UU
  := ∑ mm : disp_invmodification_data, is_disp_invmodification mm.

Coercion disp_invmodification_to_disp_invmodification_data (αα : disp_invmodification)
  : disp_invmodification_data
  := pr1 αα.

Definition disp_modification_of_invmodification (mm : disp_invmodification) :
  disp_modification α β FF₁ FF₂ αα ββ (pr1 m).
Proof.
  use tpair.
  - intros x xx. exact (pr1 mm x xx).
  - simpl. exact (pr2 mm).
Defined.

Lemma is_invertible_disp_invmodification (mm : disp_invmodification) :
  is_invertible_disp_modification _ _ _ _ _ _ _ (disp_modification_of_invmodification mm).
Proof.
  use tpair.
  - exact (pr2 m).
  - simpl. intros x xx.
    exact (pr2 (pr1 mm x xx)).
Qed.

Lemma is_disp_invmodification_from_total (mm : disp_invmodification_data)
  : is_modification (total_invmodification_data mm) → is_disp_invmodification mm.
Proof.
  intros Hmm.
  pose (Em := make_modification _ Hmm).
  intros x y f xx yy ff.
  pose (P := !fiber_paths (@modnaturality_of _ _ _ _ _ _ Em (x,,xx) (y,,yy) (f,,ff))).
  symmetry.
  etrans. { apply maponpaths. exact P. }
  unfold transportb.
  rewrite transport_f_f.
  rewrite transportf_set.
  * apply idpath.
  * apply B₂.
Qed.

Lemma total_invmodification_laws (mm : disp_invmodification)
  : is_modification (total_invmodification_data mm).
Proof.
  intros x y f.
  use total2_paths_b.
  - apply (modnaturality_of (pr1 m) (pr1 x) (pr1 y) (pr1 f)).
  - apply mm.
Qed.

Definition total_invmodification (mm : disp_invmodification)
  : invertible_modification (total_pstrans _ _ _ αα) (total_pstrans _ _ _ ββ).
Proof.
  use make_invertible_modification.
  - exact (total_invmodification_data mm).
  - exact (total_invmodification_laws mm).
Defined.

End DispInvModification.