generate_exact seed t id name ~ids_to_inner_types
else raise Not_a_proof
| C.AMutCase (id,uri,typeno,ty,te,patterns) ->
+ let inductive_types =
+ (match CicEnvironment.get_obj uri with
+ Cic.Constant _ -> assert false
+ | Cic.Variable _ -> assert false
+ | Cic.CurrentProof _ -> assert false
+ | Cic.InductiveDefinition (l,_,_) -> l
+ ) in
+ let (_,_,_,constructors) = List.nth inductive_types typeno in
let teid = get_id te in
- let pp = List.map (function p -> (K.ArgProof (aux p))) patterns in
- (match
- (try Some (Hashtbl.find ids_to_inner_types teid).C2A.annsynthesized
- with Not_found -> None)
- with
- Some tety -> (* we must lift up the argument *)
+ let pp = List.map2
+ (fun p (name,_) -> (K.ArgProof (aux ~name p)))
+ patterns constructors in
+ let apply_context,term =
+ (match
+ (try Some (Hashtbl.find ids_to_inner_types teid).C2A.annsynthesized
+ with Not_found -> None)
+ with
+ Some tety ->
let p = (aux te) in
- { K.proof_name = Some "name";
- K.proof_id = gen_id seed;
- K.proof_context = [];
- K.proof_apply_context = flat seed p;
- K.proof_conclude =
- { K.conclude_id = gen_id seed;
- K.conclude_aref = id;
- K.conclude_method = "Case";
- K.conclude_args = (K.Term ty)::(K.Term te)::pp;
- K.conclude_conclusion =
- try Some
- (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
- with Not_found -> None
- }
- }
- | None ->
- { K.proof_name = name;
- K.proof_id = gen_id seed;
- K.proof_context = [];
- K.proof_apply_context = [];
- K.proof_conclude =
- { K.conclude_id = gen_id seed;
- K.conclude_aref = id;
- K.conclude_method = "Case";
- K.conclude_args = (K.Term ty)::(K.Term te)::pp;
- K.conclude_conclusion =
- try Some
- (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
- with Not_found -> None
- }
- }
- )
+ (flat seed p,
+ K.Premise
+ { K.premise_id = gen_id seed;
+ K.premise_xref = p.K.proof_id;
+ K.premise_binder = p.K.proof_name;
+ K.premise_n = None
+ })
+ | None -> [],K.Term te) in
+ { K.proof_name = name;
+ K.proof_id = gen_id seed;
+ K.proof_context = [];
+ K.proof_apply_context = apply_context;
+ K.proof_conclude =
+ { K.conclude_id = gen_id seed;
+ K.conclude_aref = id;
+ K.conclude_method = "Case";
+ K.conclude_args =
+ (K.Aux (UriManager.string_of_uri uri))::
+ (K.Aux (string_of_int typeno))::(K.Term ty)::term::pp;
+ K.conclude_conclusion =
+ try Some
+ (Hashtbl.find ids_to_inner_types id).C2A.annsynthesized
+ with Not_found -> None
+ }
+ }
| C.AFix (id, no, funs) ->
let proofs =
List.map
K.conclude_aref = id;
K.conclude_method = "ByInduction";
K.conclude_args =
- K.Aux no_constructors
+ K.Aux (string_of_int no_constructors)
::K.Term (C.AAppl id ((C.AConst(idc,uri,exp_named_subst))::params_and_IP))
::method_args@other_method_args;
K.conclude_conclusion =
let cargs = args2cic premise_env args in
C.Appl (C.Const(uri,subst)::cargs)
| _ -> prerr_endline "6"; assert false)
+ else if (conclude.Con.conclude_method = "Case") then
+ (match conclude.Con.conclude_args with
+ Con.Aux(uri)::Con.Aux(notype)::Con.Term(ty)::Con.Premise(prem)::patterns ->
+ C.MutCase
+ (UriManager.uri_of_string uri,
+ int_of_string notype, deannotate ty,
+ List.assoc prem.Con.premise_xref premise_env,
+ List.map
+ (function
+ Con.ArgProof p -> proof2cic [] p
+ | _ -> prerr_endline "7a"; assert false) patterns)
+ | Con.Aux(uri)::Con.Aux(notype)::Con.Term(ty)::Con.Term(te)::patterns -> C.MutCase
+ (UriManager.uri_of_string uri,
+ int_of_string notype, deannotate ty, deannotate te,
+ List.map
+ (function
+ (Con.ArgProof p) -> proof2cic [] p
+ | _ -> prerr_endline "7a"; assert false) patterns)
+ | _ -> (prerr_endline "7"; assert false))
else if (conclude.Con.conclude_method = "Apply") then
let cargs = (args2cic premise_env conclude.Con.conclude_args) in
C.Appl cargs
- else (prerr_endline "7"; assert false)
+ else (prerr_endline "8"; assert false)
and args2cic premise_env l =
List.map (arg2cic premise_env) l