X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Focaml%2Fcic_proof_checking%2FcicElim.ml;h=707a7b2b2ed522886791f670aacb7d21af1787fb;hb=358cefe50cccd4cb7d8e2a9cecb7efcb5780b8a3;hp=b46aa0b226516bcc8abab2bb9be679ef3583c435;hpb=989b06d74d4cf43b81e64e91ccaeadc8f935754a;p=helm.git

diff --git a/helm/ocaml/cic_proof_checking/cicElim.ml b/helm/ocaml/cic_proof_checking/cicElim.ml
index b46aa0b22..707a7b2b2 100644
--- a/helm/ocaml/cic_proof_checking/cicElim.ml
+++ b/helm/ocaml/cic_proof_checking/cicElim.ml
@@ -28,6 +28,8 @@ open Printf
 exception Elim_failure of string
 exception Can_t_eliminate
 
+let debug_print = fun _ -> ()
+
 let fresh_binder =
   let counter = ref ~-1 in
   function
@@ -193,12 +195,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 +243,9 @@ 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 =
-  let (obj, univ) = (CicEnvironment.get_obj uri CicUniv.empty_ugraph) in
+  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,11 +339,9 @@ 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);
 *)
-prerr_endline "generato l'eliminatore";
-prerr_endline "inizio type checking";
       let (computed_type, ugraph) =
         try
           CicTypeChecker.type_of_aux' [] [] eliminator_body CicUniv.empty_ugraph
@@ -356,8 +350,6 @@ prerr_endline "inizio type checking";
             "type checker failure while type checking:\n%s\nerror:\n%s"
             (CicPp.ppterm eliminator_body) msg))
       in
-prerr_endline "fine type checking";
-prerr_endline "inizio are convertible";
       if not (fst (CicReduction.are_convertible []
         eliminator_type computed_type ugraph))
       then
@@ -372,6 +364,12 @@ prerr_endline "inizio are convertible";
         | _ -> 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))