- mk_intros st script
- | C.ARel _ as what ->
- let _, dtext = test_depth st in
- let text = "assumption" in
- let script = [T.Apply (what, dtext ^ text)] in
- mk_intros st script
- | C.AMutConstruct _ as what ->
- let _, dtext = test_depth st in
- let script = [T.Apply (what, dtext)] in
- mk_intros st script
- | C.AAppl (_, hd :: tl) as t ->
- let proceed, dtext = test_depth st in
- let script = if proceed then
- let ty = get_type "TC2" st hd in
- let (classes, rc) as h = Cl.classify st.context ty in
- let premises, _ = P.split st.context ty in
- let decurry = List.length classes - List.length tl in
- if decurry <> 0 then
- Printf.eprintf "DECURRY: %u %s\n" decurry (CicPp.ppterm (cic t));
- assert (decurry = 0);
- if decurry < 0 then mk_proof (clear st) (appl_expand decurry t) else
- if decurry > 0 then mk_proof (clear st) (eta_expand decurry t) else
- let synth = I.S.singleton 0 in
- let text = Printf.sprintf "%u %s" (List.length classes) (Cl.to_string h) in
- match rc with
- | Some (i, j) when i > 1 && i <= List.length classes && M.is_eliminator premises ->
- let classes, tl, _, what = split2_last classes tl in
- let script, what = mk_atomic st dtext what in
- let synth = I.S.add 1 synth in
- let qs = mk_bkd_proofs (next st) synth classes tl in
- if is_rewrite_right hd then
- mk_rewrite st dtext script t what qs tl false
- else if is_rewrite_left hd then
- mk_rewrite st dtext script t what qs tl true
- else
- let using = Some hd in
- List.rev script @ convert st t @
- [T.Elim (what, using, dtext ^ text); T.Branch (qs, "")]
- | _ ->
- let qs = mk_bkd_proofs (next st) synth classes tl in
- let script, hd = mk_atomic st dtext hd in
- List.rev script @ convert st t @
- [T.Apply (hd, dtext ^ text); T.Branch (qs, "")]
- else
- [T.Apply (t, dtext)]
- in
- mk_intros st script
- | C.AMutCase (id, uri, tyno, outty, arg, cases) as t ->
- begin match Cn.mk_ind st.context id uri tyno outty arg cases with
- | _ (* None *) ->
- let text = Printf.sprintf "%s" "UNEXPANDED: mutcase" in
- let script = [T.Note text] in
- mk_intros st script
-(* | Some t -> mk_proof st t *)
- end
- | C.ACast (_, t, _) ->
- mk_proof st t
- | t ->
- let text = Printf.sprintf "%s: %s" "UNEXPANDED" (string_of_head t) in
- let script = [T.Note text] in
- mk_intros st script
-
-and mk_bkd_proofs st synth classes ts =
+ let entry = Some (name, hyp) in
+ let qt = proc_proof (next (add st entry intro)) t in
+ List.rev_append rqv qt
+ else
+ [T.Apply (what, dtext)]
+ in
+ mk_intros st script
+
+and proc_rel st what =
+ let _, dtext = test_depth st in
+ let text = "assumption" in
+ let script = [T.Apply (what, dtext ^ text)] in
+ mk_intros st script
+
+and proc_mutconstruct st what =
+ let _, dtext = test_depth st in
+ let script = [T.Apply (what, dtext)] in
+ mk_intros st script
+
+and proc_appl st what hd tl =
+ let proceed, dtext = test_depth st in
+ let script = if proceed then
+ let ty = get_type "TC2" st hd in
+ let (classes, rc) as h = Cl.classify st.context ty in
+ let argsno = List.length classes in
+ let diff = argsno - List.length tl in
+ if diff <> 0 then failwith (Printf.sprintf "NOT TOTAL: %i %s |--- %s" diff (Pp.ppcontext st.context) (Pp.ppterm (cic hd)));
+ let synth = I.S.singleton 0 in
+ let text = Printf.sprintf "%u %s" argsno (Cl.to_string h) in
+ let script = List.rev (mk_arg st hd) @ convert st what in
+ match rc with
+ | Some (i, j) ->
+ let classes, tl, _, where = split2_last classes tl in
+ let script = List.rev (mk_arg st where) @ script in
+ let synth = I.S.add 1 synth in
+ let qs = proc_bkd_proofs (next st) synth classes tl in
+ if is_rewrite_right hd then
+ script @ mk_rewrite st dtext where qs tl false
+ else if is_rewrite_left hd then
+ script @ mk_rewrite st dtext where qs tl true
+ else
+ let predicate = List.nth tl (argsno - i) in
+ let e = Cn.mk_pattern 0 (T.mk_arel 1 "") (* j predicate *) in
+ let using = Some hd in
+ script @
+ [T.Elim (where, using, e, dtext ^ text); T.Branch (qs, "")]
+ | None ->
+ let qs = proc_bkd_proofs (next st) synth classes tl in
+ let hd = mk_exp_args hd tl classes in
+ script @ [T.Apply (hd, dtext ^ text); T.Branch (qs, "")]
+ else
+ [T.Apply (what, dtext)]
+ in
+ mk_intros st script
+
+and proc_other st what =
+ let text = Printf.sprintf "%s: %s" "UNEXPANDED" (string_of_head what) in
+ let script = [T.Note text] in
+ mk_intros st script
+
+
+and proc_proof st = function
+ | C.ALambda (_, name, w, t) -> proc_lambda st name w t
+ | C.ALetIn (_, name, v, t) as what -> proc_letin st what name v t
+ | C.ARel _ as what -> proc_rel st what
+ | C.AMutConstruct _ as what -> proc_mutconstruct st what
+ | C.AAppl (_, hd :: tl) as what -> proc_appl st what hd tl
+ | what -> proc_other st what
+
+and proc_bkd_proofs st synth classes ts =