-(* helpers ******************************************************************)
-
-let identity x = x
-
-let comp f g x = f (g x)
-
-let cic = D.deannotate_term
-
-let split2_last l1 l2 =
-try
- let n = pred (List.length l1) in
- let before1, after1 = T.list_split n l1 in
- let before2, after2 = T.list_split n l2 in
- before1, before2, List.hd after1, List.hd after2
-with Invalid_argument _ -> failwith "A2P.split2_last"
-
-let string_of_head = function
- | C.ASort _ -> "sort"
- | C.AConst _ -> "const"
- | C.AMutInd _ -> "mutind"
- | C.AMutConstruct _ -> "mutconstruct"
- | C.AVar _ -> "var"
- | C.ARel _ -> "rel"
- | C.AProd _ -> "prod"
- | C.ALambda _ -> "lambda"
- | C.ALetIn _ -> "letin"
- | C.AFix _ -> "fix"
- | C.ACoFix _ -> "cofix"
- | C.AAppl _ -> "appl"
- | C.ACast _ -> "cast"
- | C.AMutCase _ -> "mutcase"
- | C.AMeta _ -> "meta"
- | C.AImplicit _ -> "implict"
-
-let clear st = {st with intros = []; ety = None}
-
-let next st = {(clear st) with depth = succ st.depth}
-
-let set_ety st ety =
- if st.ety = None then {st with ety = ety} else st
-
-let add st entry intro ety =
- let st = set_ety st ety in
- {st with context = entry :: st.context; intros = intro :: st.intros}
-
-let test_depth st =
-try
- let msg = Printf.sprintf "Depth %u: " st.depth in
- match st.max_depth with
- | None -> true, ""
- | Some d -> if st.depth < d then true, msg else false, "DEPTH EXCEDED: "
-with Invalid_argument _ -> failwith "A2P.test_depth"
-
-let is_rewrite_right = function
- | C.AConst (_, uri, []) ->
- UM.eq uri HObj.Logic.eq_ind_r_URI || Obj.is_eq_ind_r_URI uri
- | _ -> false
-
-let is_rewrite_left = function
- | C.AConst (_, uri, []) ->
- UM.eq uri HObj.Logic.eq_ind_URI || Obj.is_eq_ind_URI uri
- | _ -> false
-
-let is_fwd_rewrite_right hd tl =
- if is_rewrite_right hd then match List.nth tl 3 with
- | C.ARel _ -> true
- | _ -> false
- else false
-
-let is_fwd_rewrite_left hd tl =
- if is_rewrite_left hd then match List.nth tl 3 with
- | C.ARel _ -> true
- | _ -> false
- else false
-(*
-let get_ind_name uri tno xcno =
-try
- let ts = match E.get_obj Un.empty_ugraph uri with
- | C.InductiveDefinition (ts, _, _,_), _ -> ts
- | _ -> assert false
- in
- let tname, cs = match List.nth ts tno with
- | (name, _, _, cs) -> name, cs
- in
- match xcno with
- | None -> tname
- | Some cno -> fst (List.nth cs (pred cno))
-with Invalid_argument _ -> failwith "A2P.get_ind_name"
-*)
-let get_inner_types st v =
-try
- let id = Ut.id_of_annterm v in
- try match Hashtbl.find st.types id with
- | {A.annsynthesized = st; A.annexpected = Some et} -> Some (st, et)
- | {A.annsynthesized = st; A.annexpected = None} -> Some (st, st)
- with Not_found -> None
-with Invalid_argument _ -> failwith "A2P.get_inner_types"
-
-let get_inner_sort st v =
-try
- let id = Ut.id_of_annterm v in
- try Hashtbl.find st.sorts id
- with Not_found -> `Type (CicUniv.fresh())
-with Invalid_argument _ -> failwith "A2P.get_sort"
-
-(* proof construction *******************************************************)
-
-let unused_premise = "UNUSED"
-
-let defined_premise = "DEFINED"
-
-let assumed_premise = "ASSUMED"
-
-let expanded_premise = "EXPANDED"
-
-let convert st ?name v =
- match get_inner_types st v with
- | None -> []
- | Some (st, et) ->
- let cst, cet = cic st, cic et in
- if PER.alpha_equivalence cst cet then [] else
- match name with
- | None -> [T.Change (st, et, None, "")]
- | Some id -> [T.Change (st, et, Some (id, id), ""); T.ClearBody (id, "")]
-
-let eta_expand n t =
- let id = Ut.id_of_annterm t in
- let ty = C.AImplicit ("", None) in
- let name i = Printf.sprintf "%s%u" expanded_premise i in
- let lambda i t = C.ALambda (id, C.Name (name i), ty, t) in
- let arg i n = T.mk_arel (n - i) (name i) in
- let rec aux i f a =
- if i >= n then f, a else aux (succ i) (comp f (lambda i)) (arg i n :: a)
- in
- let absts, args = aux 0 identity [] in
- match Cn.lift 1 n t with
- | C.AAppl (id, ts) -> absts (C.AAppl (id, ts @ args))
- | t -> absts (C.AAppl ("", t :: args))
-
-let appl_expand n = function
- | C.AAppl (id, ts) ->
- let before, after = T.list_split (List.length ts + n) ts in
- C.AAppl ("", C.AAppl (id, before) :: after)
- | _ -> assert false
-
-let get_intro name t =
-try
-match name with
- | C.Anonymous -> unused_premise
- | C.Name s ->
- if DTI.does_not_occur 1 (cic t) then unused_premise else s
-with Invalid_argument _ -> failwith "A2P.get_intro"