open Prims
type qpats = FStarC_Syntax_Syntax.args Prims.list
type connective =
  | QAll of (FStarC_Syntax_Syntax.binders * qpats * FStarC_Syntax_Syntax.typ)
  
  | QEx of (FStarC_Syntax_Syntax.binders * qpats * FStarC_Syntax_Syntax.typ)
  
  | BaseConn of (FStarC_Ident.lident * FStarC_Syntax_Syntax.args) 
let uu___is_QAll (projectee : connective) : Prims.bool=
  match projectee with | QAll _0 -> true | uu___ -> false
let __proj__QAll__item___0 (projectee : connective) :
  (FStarC_Syntax_Syntax.binders * qpats * FStarC_Syntax_Syntax.typ)=
  match projectee with | QAll _0 -> _0
let uu___is_QEx (projectee : connective) : Prims.bool=
  match projectee with | QEx _0 -> true | uu___ -> false
let __proj__QEx__item___0 (projectee : connective) :
  (FStarC_Syntax_Syntax.binders * qpats * FStarC_Syntax_Syntax.typ)=
  match projectee with | QEx _0 -> _0
let uu___is_BaseConn (projectee : connective) : Prims.bool=
  match projectee with | BaseConn _0 -> true | uu___ -> false
let __proj__BaseConn__item___0 (projectee : connective) :
  (FStarC_Ident.lident * FStarC_Syntax_Syntax.args)=
  match projectee with | BaseConn _0 -> _0
let connective_to_string (c : connective) : Prims.string=
  match c with
  | QAll p ->
      let uu___ =
        FStarC_Class_Show.show
          (FStarC_Class_Show.show_tuple3
             (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder)
             (FStarC_Class_Show.show_list
                (FStarC_Class_Show.show_list
                   (FStarC_Class_Show.show_tuple2
                      FStarC_Syntax_Print.showable_term
                      FStarC_Syntax_Print.showable_aqual)))
             FStarC_Syntax_Print.showable_term) p in
      Prims.strcat "QAll " uu___
  | QEx p ->
      let uu___ =
        FStarC_Class_Show.show
          (FStarC_Class_Show.show_tuple3
             (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder)
             (FStarC_Class_Show.show_list
                (FStarC_Class_Show.show_list
                   (FStarC_Class_Show.show_tuple2
                      FStarC_Syntax_Print.showable_term
                      FStarC_Syntax_Print.showable_aqual)))
             FStarC_Syntax_Print.showable_term) p in
      Prims.strcat "QEx " uu___
  | BaseConn p ->
      let uu___ =
        FStarC_Class_Show.show
          (FStarC_Class_Show.show_tuple2 FStarC_Ident.showable_lident
             (FStarC_Class_Show.show_list
                (FStarC_Class_Show.show_tuple2
                   FStarC_Syntax_Print.showable_term
                   FStarC_Syntax_Print.showable_aqual))) p in
      Prims.strcat "BaseConn" uu___
let showable_connective : connective FStarC_Class_Show.showable=
  { FStarC_Class_Show.show = connective_to_string }
let destruct_base_table :
  (Prims.int * (FStarC_Ident.lident * FStarC_Ident.lident) Prims.list)
    Prims.list=
  let f x = (x, x) in
  [(Prims.int_zero,
     [f FStarC_Parser_Const.true_lid; f FStarC_Parser_Const.false_lid]);
  (Prims.int_one, [f FStarC_Parser_Const.not_lid]);
  ((Prims.of_int (2)),
    [f FStarC_Parser_Const.and_lid;
    f FStarC_Parser_Const.or_lid;
    f FStarC_Parser_Const.imp_lid;
    f FStarC_Parser_Const.iff_lid;
    f FStarC_Parser_Const.eq2_lid]);
  ((Prims.of_int (3)),
    [f FStarC_Parser_Const.ite_lid; f FStarC_Parser_Const.eq2_lid])]
let destruct_sq_base_table :
  (Prims.int * (FStarC_Ident.lident * FStarC_Ident.lident) Prims.list)
    Prims.list=
  [(Prims.int_zero,
     [(FStarC_Parser_Const.c_true_lid, FStarC_Parser_Const.true_lid);
     (FStarC_Parser_Const.empty_type_lid, FStarC_Parser_Const.false_lid)]);
  ((Prims.of_int (2)),
    [(FStarC_Parser_Const.c_and_lid, FStarC_Parser_Const.and_lid);
    (FStarC_Parser_Const.c_or_lid, FStarC_Parser_Const.or_lid);
    (FStarC_Parser_Const.c_eq2_lid, FStarC_Parser_Const.eq2_lid)]);
  ((Prims.of_int (3)),
    [(FStarC_Parser_Const.c_eq2_lid, FStarC_Parser_Const.eq2_lid)])]
let rec unmeta_monadic (f : FStarC_Syntax_Syntax.term) :
  FStarC_Syntax_Syntax.term=
  let f1 = FStarC_Syntax_Subst.compress f in
  match f1.FStarC_Syntax_Syntax.n with
  | FStarC_Syntax_Syntax.Tm_meta
      { FStarC_Syntax_Syntax.tm2 = t;
        FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_monadic uu___;_}
      -> unmeta_monadic t
  | FStarC_Syntax_Syntax.Tm_meta
      { FStarC_Syntax_Syntax.tm2 = t;
        FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_monadic_lift
          uu___;_}
      -> unmeta_monadic t
  | uu___ -> f1
let lookup_arity_lid
  (table :
    (Prims.int * (FStarC_Ident.lident * FStarC_Ident.lident) Prims.list)
      Prims.list)
  (target_lid : FStarC_Ident.lident) (args : FStarC_Syntax_Syntax.args) :
  connective FStar_Pervasives_Native.option=
  let arg_len = FStarC_List.length args in
  let aux uu___ =
    match uu___ with
    | (arity, lids) ->
        if arg_len = arity
        then
          FStarC_Util.find_map lids
            (fun uu___1 ->
               match uu___1 with
               | (lid, out_lid) ->
                   let uu___2 = FStarC_Ident.lid_equals target_lid lid in
                   if uu___2
                   then
                     FStar_Pervasives_Native.Some (BaseConn (out_lid, args))
                   else FStar_Pervasives_Native.None)
        else FStar_Pervasives_Native.None in
  FStarC_Util.find_map table aux
let destruct_base_conn (t : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  let uu___ = FStarC_Syntax_Util.head_and_args_full t in
  match uu___ with
  | (hd, args) ->
      let uu___1 =
        let uu___2 = FStarC_Syntax_Util.un_uinst hd in
        uu___2.FStarC_Syntax_Syntax.n in
      (match uu___1 with
       | FStarC_Syntax_Syntax.Tm_fvar fv ->
           lookup_arity_lid destruct_base_table
             fv.FStarC_Syntax_Syntax.fv_name args
       | uu___2 -> FStar_Pervasives_Native.None)
let destruct_sq_base_conn (uu___ : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  (fun t ->
     let uu___ = FStarC_Syntax_Util.un_squash t in
     Obj.magic
       (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_option () ()
          (Obj.magic uu___)
          (fun uu___1 ->
             (fun t1 ->
                let t1 = Obj.magic t1 in
                let t2 = FStarC_Syntax_Util.unmeta t1 in
                let uu___1 = FStarC_Syntax_Util.head_and_args_full t2 in
                match uu___1 with
                | (hd, args) ->
                    let uu___2 =
                      let uu___3 = FStarC_Syntax_Util.un_uinst hd in
                      uu___3.FStarC_Syntax_Syntax.n in
                    (match uu___2 with
                     | FStarC_Syntax_Syntax.Tm_fvar fv ->
                         Obj.magic
                           (lookup_arity_lid destruct_sq_base_table
                              fv.FStarC_Syntax_Syntax.fv_name args)
                     | uu___3 -> Obj.magic FStar_Pervasives_Native.None))
               uu___1))) uu___
let patterns (t : FStarC_Syntax_Syntax.term) :
  ((FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax *
    FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option)
    Prims.list Prims.list * FStarC_Syntax_Syntax.term)=
  let t1 = FStarC_Syntax_Subst.compress t in
  match t1.FStarC_Syntax_Syntax.n with
  | FStarC_Syntax_Syntax.Tm_meta
      { FStarC_Syntax_Syntax.tm2 = t2;
        FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_pattern
          (uu___, pats);_}
      -> let uu___1 = FStarC_Syntax_Subst.compress t2 in (pats, uu___1)
  | uu___ -> ([], t1)
let destruct_q_conn (t : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  let is_q fa fv =
    if fa
    then FStarC_Syntax_Util.is_forall fv.FStarC_Syntax_Syntax.fv_name
    else FStarC_Syntax_Util.is_exists fv.FStarC_Syntax_Syntax.fv_name in
  let flat t1 =
    let uu___ = FStarC_Syntax_Util.head_and_args_full t1 in
    match uu___ with
    | (t2, args) ->
        let uu___1 = FStarC_Syntax_Util.un_uinst t2 in
        let uu___2 =
          FStarC_List.map
            (fun uu___3 ->
               match uu___3 with
               | (t3, imp) ->
                   let uu___4 = FStarC_Syntax_Util.unascribe t3 in
                   (uu___4, imp)) args in
        (uu___1, uu___2) in
  let rec aux qopt out t1 =
    let uu___ = let uu___1 = flat t1 in (qopt, uu___1) in
    match uu___ with
    | (FStar_Pervasives_Native.Some fa,
       ({ FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar tc;
          FStarC_Syntax_Syntax.pos = uu___1;
          FStarC_Syntax_Syntax.vars = uu___2;
          FStarC_Syntax_Syntax.hash_code = uu___3;_},
        ({
           FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_abs
             { FStarC_Syntax_Syntax.bs = b::[];
               FStarC_Syntax_Syntax.body = t2;
               FStarC_Syntax_Syntax.rc_opt = uu___4;_};
           FStarC_Syntax_Syntax.pos = uu___5;
           FStarC_Syntax_Syntax.vars = uu___6;
           FStarC_Syntax_Syntax.hash_code = uu___7;_},
         uu___8)::[]))
        when is_q fa tc -> aux qopt (b :: out) t2
    | (FStar_Pervasives_Native.Some fa,
       ({ FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar tc;
          FStarC_Syntax_Syntax.pos = uu___1;
          FStarC_Syntax_Syntax.vars = uu___2;
          FStarC_Syntax_Syntax.hash_code = uu___3;_},
        uu___4::({
                   FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_abs
                     { FStarC_Syntax_Syntax.bs = b::[];
                       FStarC_Syntax_Syntax.body = t2;
                       FStarC_Syntax_Syntax.rc_opt = uu___5;_};
                   FStarC_Syntax_Syntax.pos = uu___6;
                   FStarC_Syntax_Syntax.vars = uu___7;
                   FStarC_Syntax_Syntax.hash_code = uu___8;_},
                 uu___9)::[]))
        when is_q fa tc -> aux qopt (b :: out) t2
    | (FStar_Pervasives_Native.None,
       ({ FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar tc;
          FStarC_Syntax_Syntax.pos = uu___1;
          FStarC_Syntax_Syntax.vars = uu___2;
          FStarC_Syntax_Syntax.hash_code = uu___3;_},
        ({
           FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_abs
             { FStarC_Syntax_Syntax.bs = b::[];
               FStarC_Syntax_Syntax.body = t2;
               FStarC_Syntax_Syntax.rc_opt = uu___4;_};
           FStarC_Syntax_Syntax.pos = uu___5;
           FStarC_Syntax_Syntax.vars = uu___6;
           FStarC_Syntax_Syntax.hash_code = uu___7;_},
         uu___8)::[]))
        when FStarC_Syntax_Util.is_qlid tc.FStarC_Syntax_Syntax.fv_name ->
        let uu___9 =
          let uu___10 =
            FStarC_Syntax_Util.is_forall tc.FStarC_Syntax_Syntax.fv_name in
          FStar_Pervasives_Native.Some uu___10 in
        aux uu___9 (b :: out) t2
    | (FStar_Pervasives_Native.None,
       ({ FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar tc;
          FStarC_Syntax_Syntax.pos = uu___1;
          FStarC_Syntax_Syntax.vars = uu___2;
          FStarC_Syntax_Syntax.hash_code = uu___3;_},
        uu___4::({
                   FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_abs
                     { FStarC_Syntax_Syntax.bs = b::[];
                       FStarC_Syntax_Syntax.body = t2;
                       FStarC_Syntax_Syntax.rc_opt = uu___5;_};
                   FStarC_Syntax_Syntax.pos = uu___6;
                   FStarC_Syntax_Syntax.vars = uu___7;
                   FStarC_Syntax_Syntax.hash_code = uu___8;_},
                 uu___9)::[]))
        when FStarC_Syntax_Util.is_qlid tc.FStarC_Syntax_Syntax.fv_name ->
        let uu___10 =
          let uu___11 =
            FStarC_Syntax_Util.is_forall tc.FStarC_Syntax_Syntax.fv_name in
          FStar_Pervasives_Native.Some uu___11 in
        aux uu___10 (b :: out) t2
    | (FStar_Pervasives_Native.Some b, uu___1) ->
        let bs = FStarC_List.rev out in
        let uu___2 = FStarC_Syntax_Subst.open_term bs t1 in
        (match uu___2 with
         | (bs1, t2) ->
             let uu___3 = patterns t2 in
             (match uu___3 with
              | (pats, body) ->
                  if b
                  then FStar_Pervasives_Native.Some (QAll (bs1, pats, body))
                  else FStar_Pervasives_Native.Some (QEx (bs1, pats, body))))
    | uu___1 -> FStar_Pervasives_Native.None in
  aux FStar_Pervasives_Native.None [] t
let rec destruct_sq_forall (uu___ : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  (fun t ->
     let uu___ = FStarC_Syntax_Util.un_squash t in
     Obj.magic
       (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_option () ()
          (Obj.magic uu___)
          (fun uu___1 ->
             (fun t1 ->
                let t1 = Obj.magic t1 in
                let t2 = FStarC_Syntax_Util.unmeta t1 in
                let uu___1 = FStarC_Syntax_Util.arrow_one t2 in
                match uu___1 with
                | FStar_Pervasives_Native.Some (b, c) ->
                    let uu___2 =
                      let uu___3 = FStarC_Syntax_Util.is_tot_or_gtot_comp c in
                      Prims.op_Negation uu___3 in
                    if uu___2
                    then Obj.magic FStar_Pervasives_Native.None
                    else
                      (let q = FStarC_Syntax_Util.comp_result c in
                       let uu___4 =
                         FStarC_Syntax_Util.is_free_in
                           b.FStarC_Syntax_Syntax.binder_bv q in
                       if uu___4
                       then
                         let uu___5 = patterns q in
                         match uu___5 with
                         | (pats, q1) ->
                             Obj.magic
                               (maybe_collect
                                  (FStar_Pervasives_Native.Some
                                     (QAll ([b], pats, q1))))
                       else
                         (let uu___6 =
                            let uu___7 =
                              let uu___8 =
                                let uu___9 =
                                  FStarC_Syntax_Syntax.as_arg
                                    (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort in
                                let uu___10 =
                                  let uu___11 = FStarC_Syntax_Syntax.as_arg q in
                                  [uu___11] in
                                uu___9 :: uu___10 in
                              (FStarC_Parser_Const.imp_lid, uu___8) in
                            BaseConn uu___7 in
                          Obj.magic (FStar_Pervasives_Native.Some uu___6)))
                | uu___2 -> Obj.magic FStar_Pervasives_Native.None) uu___1)))
    uu___
and destruct_sq_exists (uu___ : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  (fun t ->
     let uu___ = FStarC_Syntax_Util.un_squash t in
     Obj.magic
       (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_option () ()
          (Obj.magic uu___)
          (fun uu___1 ->
             (fun t1 ->
                let t1 = Obj.magic t1 in
                let t2 = FStarC_Syntax_Util.unmeta t1 in
                let uu___1 = FStarC_Syntax_Util.head_and_args_full t2 in
                match uu___1 with
                | (hd, args) ->
                    let uu___2 =
                      let uu___3 =
                        let uu___4 = FStarC_Syntax_Util.un_uinst hd in
                        uu___4.FStarC_Syntax_Syntax.n in
                      (uu___3, args) in
                    (match uu___2 with
                     | (FStarC_Syntax_Syntax.Tm_fvar fv,
                        (a1, uu___3)::(a2, uu___4)::[]) when
                         FStarC_Syntax_Syntax.fv_eq_lid fv
                           FStarC_Parser_Const_Tuples.lid_dtuple2
                         ->
                         let uu___5 =
                           let uu___6 = FStarC_Syntax_Subst.compress a2 in
                           uu___6.FStarC_Syntax_Syntax.n in
                         (match uu___5 with
                          | FStarC_Syntax_Syntax.Tm_abs
                              { FStarC_Syntax_Syntax.bs = b::[];
                                FStarC_Syntax_Syntax.body = q;
                                FStarC_Syntax_Syntax.rc_opt = uu___6;_}
                              ->
                              let uu___7 =
                                FStarC_Syntax_Subst.open_term [b] q in
                              (match uu___7 with
                               | (bs, q1) ->
                                   let b1 =
                                     match bs with
                                     | b2::[] -> b2
                                     | uu___8 -> failwith "impossible" in
                                   let uu___8 = patterns q1 in
                                   (match uu___8 with
                                    | (pats, q2) ->
                                        Obj.magic
                                          (maybe_collect
                                             (FStar_Pervasives_Native.Some
                                                (QEx ([b1], pats, q2))))))
                          | uu___6 -> Obj.magic FStar_Pervasives_Native.None)
                     | uu___3 -> Obj.magic FStar_Pervasives_Native.None))
               uu___1))) uu___
and maybe_collect (f : connective FStar_Pervasives_Native.option) :
  connective FStar_Pervasives_Native.option=
  match f with
  | FStar_Pervasives_Native.Some (QAll (bs, pats, phi)) ->
      let uu___ = destruct_sq_forall phi in
      (match uu___ with
       | FStar_Pervasives_Native.Some (QAll (bs', pats', psi)) ->
           FStar_Pervasives_Native.Some
             (QAll
                ((FStarC_List.op_At bs bs'), (FStarC_List.op_At pats pats'),
                  psi))
       | uu___1 -> f)
  | FStar_Pervasives_Native.Some (QEx (bs, pats, phi)) ->
      let uu___ = destruct_sq_exists phi in
      (match uu___ with
       | FStar_Pervasives_Native.Some (QEx (bs', pats', psi)) ->
           FStar_Pervasives_Native.Some
             (QEx
                ((FStarC_List.op_At bs bs'), (FStarC_List.op_At pats pats'),
                  psi))
       | uu___1 -> f)
  | uu___ -> f
let destruct_typ_as_formula (f : FStarC_Syntax_Syntax.term) :
  connective FStar_Pervasives_Native.option=
  let phi = unmeta_monadic f in
  let r =
    let uu___ = destruct_base_conn phi in
    FStarC_Option.catch uu___
      (fun uu___1 ->
         let uu___2 = destruct_q_conn phi in
         FStarC_Option.catch uu___2
           (fun uu___3 ->
              let uu___4 = destruct_sq_base_conn phi in
              FStarC_Option.catch uu___4
                (fun uu___5 ->
                   let uu___6 = destruct_sq_forall phi in
                   FStarC_Option.catch uu___6
                     (fun uu___7 ->
                        let uu___8 = destruct_sq_exists phi in
                        FStarC_Option.catch uu___8
                          (fun uu___9 -> FStar_Pervasives_Native.None))))) in
  r
