X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Focaml%2Fcic_proof_checking%2FcicElim.ml;h=c0552e79ee7385c38bbf3f0781c8895eab8897e3;hb=16cfd31fa90759c8318b6bb12c992c45df60c41b;hp=d87d7eb4fdd991654f79fc035596b52a2c843c6e;hpb=ea71e96f90757766465abbdd22aec34d095dbf1d;p=helm.git diff --git a/helm/ocaml/cic_proof_checking/cicElim.ml b/helm/ocaml/cic_proof_checking/cicElim.ml index d87d7eb4f..c0552e79e 100644 --- a/helm/ocaml/cic_proof_checking/cicElim.ml +++ b/helm/ocaml/cic_proof_checking/cicElim.ml @@ -28,8 +28,11 @@ open Printf exception Elim_failure of string exception Can_t_eliminate +let debug_print = fun _ -> () + +let counter = ref ~-1 ;; + let fresh_binder = - let counter = ref ~-1 in function | true -> incr counter; @@ -193,12 +196,6 @@ function Cic.Lambda (fresh_binder true, CicSubstitution.lift_from (rightno + 1) liftno indty, case) -let string_of_sort = function - | Cic.Prop -> "Prop" - | Cic.CProp -> "CProp" - | Cic.Set -> "Set" - | Cic.Type _ -> "Type" - let rec branch (uri, typeno) insource paramsno t fix head args = match t with | Cic.MutInd (uri', typeno', []) when @@ -247,9 +244,10 @@ let branch (uri, typeno) insource liftno paramsno t fix head args = branch (uri, typeno) insource paramsno t fix head args let elim_of ?(sort = Cic.Type (CicUniv.fresh ())) uri typeno = + counter := ~-1; let (obj, univ) = (CicEnvironment.get_obj CicUniv.empty_ugraph uri) in match obj with - | Cic.InductiveDefinition (indTypes, params, leftno) -> + | Cic.InductiveDefinition (indTypes, params, leftno, _) -> let (name, inductive, ty, constructors) = try List.nth indTypes typeno @@ -343,8 +341,8 @@ 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 (* -prerr_endline (CicPp.ppterm eliminator_type); -prerr_endline (CicPp.ppterm eliminator_body); +debug_print (CicPp.ppterm eliminator_type); +debug_print (CicPp.ppterm eliminator_body); *) let (computed_type, ugraph) = try @@ -368,6 +366,12 @@ prerr_endline (CicPp.ppterm eliminator_body); | _ -> assert false in let name = UriManager.name_of_uri uri ^ suffix in - Cic.Constant (name, Some eliminator_body, eliminator_type, []) - | _ -> assert false + let buri = UriManager.buri_of_uri uri in + let uri = UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con") in + let obj_attrs = [`Class (`Elim sort); `Generated] in + uri, + Cic.Constant (name, Some eliminator_body, eliminator_type, [], obj_attrs) + | _ -> + failwith (sprintf "not an inductive definition (%s)" + (UriManager.string_of_uri uri))