X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_proof_checking%2FcicElim.ml;h=fb568613c943c8b3b7389d9d09d039d8e88b8046;hb=c3b6e22034e3029195031d31c94983c381ae659b;hp=eecb0fae6a97826e037e8c150b14d3493a0d7c67;hpb=f263e4ec717d5ec2e7f9c057855f8223f81baae8;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicElim.ml b/helm/ocaml/cic_proof_checking/cicElim.ml index eecb0fae6..fb568613c 100644 --- a/helm/ocaml/cic_proof_checking/cicElim.ml +++ b/helm/ocaml/cic_proof_checking/cicElim.ml @@ -29,12 +29,14 @@ exception Elim_failure of string exception Can_t_eliminate let debug_print = fun _ -> () +(*let debug_print s = prerr_endline (Lazy.force s) *) let counter = ref ~-1 ;; -let fresh_binder () = +let fresh_binder () = Cic.Name "matita_dummy" +(* incr counter; - Cic.Name ("e" ^ string_of_int !counter) + Cic.Name ("e" ^ string_of_int !counter) *) (** verifies if a given inductive type occurs in a term in target position *) let rec recursive uri typeno = function @@ -319,9 +321,23 @@ let elim_of ?(sort = Cic.Type (CicUniv.fresh ())) uri typeno = (shift + 1, b :: branches)) constructors (1, []) in + let shiftno = conslen + rightno + 2 + recshift in + let outtype = + if dependent then + Cic.Rel shiftno + else + let head = + if rightno = 0 then + CicSubstitution.lift 1 (Cic.Rel shiftno) + else + Cic.Appl + ((CicSubstitution.lift (rightno + 1) (Cic.Rel shiftno)) :: + mk_rels 1 rightno) + in + add_right_lambda true leftno shiftno 1 rightno indty head ty + in let mutcase = - Cic.MutCase (uri, typeno, Cic.Rel (conslen + rightno + 2 + recshift), - Cic.Rel 1, branches) + Cic.MutCase (uri, typeno, outtype, Cic.Rel 1, branches) in let body = if is_recursive then @@ -351,8 +367,16 @@ let elim_of ?(sort = Cic.Type (CicUniv.fresh ())) uri typeno = add_params (fun b s t -> Cic.Lambda (b, s, t)) leftno ty cic in (* -debug_print (CicPp.ppterm eliminator_type); -debug_print (CicPp.ppterm eliminator_body); +debug_print (lazy (CicPp.ppterm eliminator_type)); +debug_print (lazy (CicPp.ppterm eliminator_body)); +*) + let eliminator_type = + FreshNamesGenerator.mk_fresh_names [] [] [] eliminator_type in + let eliminator_body = + FreshNamesGenerator.mk_fresh_names [] [] [] eliminator_body in +(* +debug_print (lazy (CicPp.ppterm eliminator_type)); +debug_print (lazy (CicPp.ppterm eliminator_body)); *) let (computed_type, ugraph) = try