X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Facic_procedural%2FproceduralOptimizer.ml;h=f1840cf7c95c75cf37877712fdfa70fdb66caa34;hb=fc577dad1529b2d90c40dad8e6e3429281107c99;hp=1b4cbd8e003ca3790f89f21c2f72ec465036bc35;hpb=0b76904a3f10bfd6390d26172fd6979626bd72f4;p=helm.git diff --git a/helm/software/components/acic_procedural/proceduralOptimizer.ml b/helm/software/components/acic_procedural/proceduralOptimizer.ml index 1b4cbd8e0..f1840cf7c 100644 --- a/helm/software/components/acic_procedural/proceduralOptimizer.ml +++ b/helm/software/components/acic_procedural/proceduralOptimizer.ml @@ -46,6 +46,8 @@ let debug = ref false (* term optimization ********************************************************) +let critical = ref true + type status = { dummy: unit; info: string @@ -68,8 +70,8 @@ let clear_absts m = aux 0 (pred n) (S.lift (-1) t) | t when n > 0 -> Printf.eprintf "PO.clear_absts: %u %s\n" n (Pp.ppterm t); - assert false - | t -> t + assert false + | t -> t in aux m @@ -177,7 +179,7 @@ and opt_appl g st es c t vs = in if es then H.list_fold_right_cps g map vs (st, []) else g (st, vs) -and opt_mutcase g st es c uri tyno outty arg cases = +and opt_mutcase_critical g st es c uri tyno outty arg cases = let eliminator = H.get_default_eliminator c uri tyno outty in let lpsno, (_, _, _, constructors) = H.get_ind_type uri tyno in let ps, sort_disp = H.get_ind_parameters c arg in @@ -206,6 +208,13 @@ and opt_mutcase g st es c uri tyno outty arg cases = let x = H.refine c (C.Appl args) in opt_proof g (info st "Optimizer: remove 3") es c x +and opt_mutcase_plain g st es c uri tyno outty arg cases = + let g st v ts = g st (C.MutCase (uri, tyno, outty, v, ts)) in + g st arg cases + +and opt_mutcase g = + if !critical then opt_mutcase_critical g else opt_mutcase_plain g + and opt_cast g st es c t w = let g st t = g (info st "Optimizer: remove 4") t in if es then opt_proof g st es c t else g st t