X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=57491cbdaf4d4ddf46f936b415f1622d100f6d72;hb=31cb2f0b374657eb5acb95708443e2c1b8481891;hp=bd0fd6ceac3faa2b7afa82011b96396bb88a4983;hpb=974970b91996a4caae7af96b85acde33254cdfc9;p=helm.git diff --git a/matita/components/grafite_engine/grafiteEngine.ml b/matita/components/grafite_engine/grafiteEngine.ml index bd0fd6cea..57491cbda 100644 --- a/matita/components/grafite_engine/grafiteEngine.ml +++ b/matita/components/grafite_engine/grafiteEngine.ml @@ -634,7 +634,16 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = (*HLog.warn "error in generating projection/eliminator";*) status ) status boxml in - let _,_,_,_,nobj = obj in + let _,_,_,_,nobj = obj in + (* attempting to generate an inversion principle on the maximum + * universe can take a long time to fail: this code removes maximal + * sorts from the universe list *) + let universes = NCicEnvironment.get_universes () in + let max_univ = List.fold_left max [] universes in + let universes = + List.filter (fun x -> NCicEnvironment.universe_lt x max_univ) + universes + in let status = match nobj with NCic.Inductive (is_ind,leftno,itl,_) -> List.fold_left (fun status it -> @@ -654,12 +663,13 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false)) | _ -> status)) (* XXX *) - with _ -> (*HLog.warn "error in generating inversion principle"; *) + with + Sys.Break as exn -> raise exn + | _ -> (*HLog.warn "error in generating inversion principle"; *) let status = status#set_ng_mode `CommandMode in status) status (NCic.Prop:: - List.map (fun s -> NCic.Type s) - (NCicEnvironment.get_universes ())))) status itl + List.map (fun s -> NCic.Type s) universes))) status itl | _ -> status in let status = match nobj with @@ -707,7 +717,9 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) | _ -> status)) (* XXX *) - with _ -> (*HLog.warn "error in generating discrimination principle"; *) + with + Sys.Break as exn -> raise exn + | _ -> (*HLog.warn "error in generating discrimination principle"; *) let status = status#set_ng_mode `CommandMode in status) status' itl