X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Flibrary%2FcicElim.ml;h=282383d7853ae344ecbb75e09ca45e9d586202c7;hb=b91dfc5e2b00e6b0b4cb81109192bb2b825055a1;hp=22bece0338e08f7a777a11464cd6ca5adcbaaf8e;hpb=e0142811b372f3c32d34f78dc4ff8ca74b02ef63;p=helm.git diff --git a/helm/software/components/library/cicElim.ml b/helm/software/components/library/cicElim.ml index 22bece033..282383d78 100644 --- a/helm/software/components/library/cicElim.ml +++ b/helm/software/components/library/cicElim.ml @@ -150,14 +150,20 @@ let rec mk_rels consno = function | 0 -> [] | n -> Cic.Rel (n+consno) :: mk_rels consno (n-1) -let rec strip_pi = function - | Cic.Prod (_, _, tgt) -> strip_pi tgt +let rec strip_pi ctx t = + match CicReduction.whd ~delta:true ctx t with + | Cic.Prod (n, s, tgt) -> strip_pi (Some (n,Cic.Decl s) :: ctx) tgt | t -> t -let rec count_pi = function - | Cic.Prod (_, _, tgt) -> count_pi tgt + 1 +let strip_pi t = strip_pi [] t + +let rec count_pi ctx t = + match CicReduction.whd ~delta:true ctx t with + | Cic.Prod (n, s, tgt) -> count_pi (Some (n,Cic.Decl s)::ctx) tgt + 1 | t -> 0 +let count_pi t = count_pi [] t + let rec type_of_p sort dependent leftno indty = function | Cic.Prod (n, src, tgt) when leftno = 0 -> let n = @@ -259,7 +265,7 @@ let branch (uri, typeno) insource liftno paramsno t fix head args = let elim_of ~sort uri typeno = counter := ~-1; - let (obj, univ) = (CicEnvironment.get_obj CicUniv.empty_ugraph uri) in + let (obj, univ) = (CicEnvironment.get_obj CicUniv.oblivion_ugraph uri) in match obj with | Cic.InductiveDefinition (indTypes, params, leftno, _) -> let (name, inductive, ty, constructors) = @@ -267,6 +273,10 @@ let elim_of ~sort uri typeno = List.nth indTypes typeno with Failure _ -> assert false in + let ty = Unshare.unshare ~fresh_univs:true ty in + let constructors = + List.map (fun (name,c)-> name,Unshare.unshare ~fresh_univs:true c) constructors + in let paramsno = count_pi ty in (* number of (left or right) parameters *) let rightno = paramsno - leftno in let dependent = (strip_pi ty <> Cic.Sort Cic.Prop) in @@ -390,7 +400,8 @@ debug_print (lazy (CicPp.ppterm eliminator_body)); *) let (computed_type, ugraph) = try - CicTypeChecker.type_of_aux' [] [] eliminator_body CicUniv.empty_ugraph + CicTypeChecker.type_of_aux' [] [] eliminator_body + CicUniv.oblivion_ugraph with CicTypeChecker.TypeCheckerFailure msg -> raise (Elim_failure (lazy (sprintf "type checker failure while type checking:\n%s\nerror:\n%s"