X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_omdoc%2Feta_fixing.ml;h=c224bcf65ad1fb25b7c36d6739ccd996ff94e644;hb=60c7321771851b82493bb202185ee184f1e7a3d1;hp=876c5c6783190d7da4829bec4d8bb848dddcf038;hpb=059db27238ba60f5c6bdf229bdb2265fa194a280;p=helm.git diff --git a/helm/ocaml/cic_omdoc/eta_fixing.ml b/helm/ocaml/cic_omdoc/eta_fixing.ml index 876c5c678..c224bcf65 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' = @@ -262,8 +260,9 @@ let eta_fix metasenv t = if noparams = 0 then List.map (fun (_,t) -> t) constructors else - let term_type = - CicTypeChecker.type_of_aux' metasenv context term in + let term_type = + CicTypeChecker.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 +270,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