X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnCicElim.ml;h=b493edb6a22f295750a96141dd74f6a5d0a68385;hb=a90c31c1b53222bd6d57360c5ba5c2d0fe7d5207;hp=359d93bbd5c72c48ff5700060fb82c4935ce0026;hpb=4377e950998c9c63937582952a79975947aa9a45;p=helm.git diff --git a/helm/software/components/ng_tactics/nCicElim.ml b/helm/software/components/ng_tactics/nCicElim.ml index 359d93bbd..b493edb6a 100644 --- a/helm/software/components/ng_tactics/nCicElim.ml +++ b/helm/software/components/ng_tactics/nCicElim.ml @@ -53,34 +53,30 @@ let mk_elim uri leftno it (outsort,suffix) pragma = let args,sort = NCicReduction.split_prods ~subst:[] [] (-1) ty in let args = List.rev_map (function name,_ -> mk_id name) args in let rec_arg = mk_id (fresh_name ()) in - let mk_prods = + let p_ty = List.fold_right - (fun name res -> CicNotationPt.Binder (`Forall,(name,None),res)) in - let p_ty = mk_prods args + (fun name res -> CicNotationPt.Binder (`Forall,(name,None),res)) args (CicNotationPt.Binder (`Forall, (rec_arg,Some (mk_appl (mk_id ind_name :: params @ args))), CicNotationPt.Sort outsort)) in - let mk_arrs n = mk_prods (HExtlib.mk_list (mk_id "_") n) in let args = args @ [rec_arg] in let k_names = List.map (function _,name,_ -> name_of_k name) cl in - (* let final_params = List.map (function name -> name, None) params @ [p_name,Some p_ty] @ List.map (function name -> name, None) k_names @ List.map (function name -> name, None) args in - *) let cty = mk_appl (p_name :: args) in let ty = Some cty in - let branches_with_args = + let branches = List.map (function (_,name,ty) -> let _,ty = NCicReduction.split_prods ~subst:[] [] leftno ty in let cargs,ty= my_split_prods ~subst:[] [] (-1) ty in - let cargs_recargs_nih = - List.fold_left - (fun (acc,nih) -> function + let cargs_and_recursive_args = + List.rev_map + (function _,NCic.Def _ -> assert false | name,NCic.Decl ty -> let context,ty = my_split_prods ~subst:[] [] (-1) ty in @@ -93,7 +89,7 @@ let mk_elim uri leftno it (outsort,suffix) pragma = -> let abs = List.rev_map (fun id,_ -> mk_id id) context in let name = mk_id name in - (name, Some ( + name, Some ( List.fold_right (fun id res -> CicNotationPt.Binder (`Lambda,(id,None),res)) @@ -105,29 +101,16 @@ let mk_elim uri leftno it (outsort,suffix) pragma = k_names @ List.map (fun _ -> CicNotationPt.Implicit `JustOne) (List.tl args) @ - [mk_appl (name::abs)]))))::acc, nih + 1 - | _ -> (mk_id name,None)::acc,nih - ) ([],0) cargs in - let cargs_and_recursive_args, nih = cargs_recargs_nih in + [mk_appl (name::abs)]))) + | _ -> mk_id name,None + ) cargs in let cargs,recursive_args = List.split cargs_and_recursive_args in let recursive_args = HExtlib.filter_map (fun x -> x) recursive_args in - (CicNotationPt.Pattern (name,None,List.map (fun x -> x,None) cargs), - mk_appl (name_of_k name :: cargs @ recursive_args)), (name,cargs, nih) + CicNotationPt.Pattern (name,None,List.map (fun x -> x,None) cargs), + mk_appl (name_of_k name :: cargs @ recursive_args) ) cl in - let branches, branch_args = List.split branches_with_args in - let bo = CicNotationPt.Case (rec_arg,Some (ind_name,None),Some p_name,branches) in - let final_params = - List.map (function name -> name, None) params @ - [p_name,Some p_ty] @ - List.map (function name, cargs, nih -> - name_of_k name, - Some (mk_prods cargs (mk_arrs nih - (mk_appl - (p_name::HExtlib.mk_list (CicNotationPt.Implicit `JustOne) - (List.length args - 1) @ - [mk_appl (mk_id name :: params @ cargs)]))))) branch_args @ - List.map (function name -> name, None) args in + let bo = CicNotationPt.Case (rec_arg,Some (ind_name,None),None,branches) in let recno = List.length final_params in let where = recno - 1 in let res =