X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_omdoc%2Feta_fixing.ml;h=81668203dab55673c8fb2ab74c2ebbcac9a0753f;hb=265cf771fbfe217b5f274b999fc3ad887683a09a;hp=876c5c6783190d7da4829bec4d8bb848dddcf038;hpb=edf601b6b8eb5b28a5292d0660a3b54b5680e580;p=helm.git diff --git a/helm/ocaml/cic_omdoc/eta_fixing.ml b/helm/ocaml/cic_omdoc/eta_fixing.ml index 876c5c678..81668203d 100644 --- a/helm/ocaml/cic_omdoc/eta_fixing.ml +++ b/helm/ocaml/cic_omdoc/eta_fixing.ml @@ -27,6 +27,8 @@ exception ReferenceToVariable;; exception RferenceToCurrentProof;; exception ReferenceToInductiveDefinition;; +let prerr_endline _ = ();; + (* let rec fix_lambdas_wrt_type ty te = let module C = Cic in @@ -163,8 +165,8 @@ let fix_according_to_type ty hd tl = let eta_fix metasenv t = let rec eta_fix' context t = - prerr_endline ("entering aux with: term=" ^ CicPp.ppterm t); - flush stderr ; + (* prerr_endline ("entering aux with: term=" ^ CicPp.ppterm t); + flush stderr ; *) let module C = Cic in let module S = CicSubstitution in match t with @@ -200,7 +202,7 @@ let eta_fix metasenv t = (n, eta_fix' context s, eta_fix' ((Some (n,(C.Decl s)))::context) t) | C.LetIn (n,s,t) -> C.LetIn - (n, eta_fix' context s, eta_fix' ((Some (n,(C.Def s)))::context) t) + (n,eta_fix' context s,eta_fix' ((Some (n,(C.Def (s,None))))::context) t) | C.Appl l as appl -> let l' = List.map (eta_fix' context) l in @@ -214,11 +216,7 @@ let eta_fix metasenv t = | C.InductiveDefinition _ -> raise ReferenceToInductiveDefinition ) in - let result = fix_according_to_type constant_type (C.Const(uri,exp_named_subst)) l'' in - if not (CicReduction.are_convertible [] appl result) then - (prerr_endline ("prima :" ^(CicPp.ppterm appl)); - prerr_endline ("dopo :" ^(CicPp.ppterm result))); - result + fix_according_to_type constant_type (C.Const(uri,exp_named_subst)) l'' | _ -> C.Appl l' ) | C.Const (uri,exp_named_subst) -> let exp_named_subst' = @@ -263,7 +261,7 @@ let eta_fix metasenv t = List.map (fun (_,t) -> t) constructors else let term_type = - CicTypeChecker.type_of_aux' metasenv context term in + TypeInference.type_of_aux' metasenv context term in (match term_type with C.Appl (hd::params) -> List.map (fun (_,t) -> clean_up t params) constructors @@ -271,12 +269,7 @@ let eta_fix metasenv t = let patterns2 = List.map2 fix_lambdas_wrt_type constructor_types patterns in - let dopo = - C.MutCase (uri, tyno, outty',term',patterns2) in - if not (CicReduction.are_convertible [] prima dopo) then - (prerr_endline ("prima :" ^(CicPp.ppterm prima)); - prerr_endline ("dopo :" ^(CicPp.ppterm dopo))); - dopo + C.MutCase (uri, tyno, outty',term',patterns2) | C.Fix (funno, funs) -> let fun_types = List.map (fun (n,_,ty,_) -> Some (C.Name n,(Cic.Decl ty))) funs in