X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fhelena%2Fsrc%2Fbasic_rg%2FbrgReduction.ml;h=4a9570d50bddd96df063b1952110af714c60aee1;hb=c44a7c4d35c1bb9651c3596519d8262e52e90ff4;hp=e62b90777fe0ebf41bcc442ec67e06d62401c203;hpb=586c361209ac14e8c2b1da3509041c0c82a86c92;p=helm.git diff --git a/helm/software/helena/src/basic_rg/brgReduction.ml b/helm/software/helena/src/basic_rg/brgReduction.ml index e62b90777..4a9570d50 100644 --- a/helm/software/helena/src/basic_rg/brgReduction.ml +++ b/helm/software/helena/src/basic_rg/brgReduction.ml @@ -10,6 +10,7 @@ V_______________________________________________________________ *) module U = NUri +module C = Cps module S = Share module L = Log module G = Options @@ -44,10 +45,11 @@ let log2 st s cu u ct t = let s1, s2, s3 = s ^ " in the environment (expected)", "the term", "and in the environment (inferred)" in L.log st BO.specs (pred level) (L.et_items2 s1 cu s2 u ~sc2:s3 ~c2:ct s2 t) -let rec list_and map = function +let rec list_and f map = function | hd1 :: tl1, hd2 :: tl2 -> - if map hd1 hd2 then list_and map (tl1, tl2) else false - | l1, l2 -> l1 = l2 + let f b = f (b && map hd1 hd2) in + list_and f map (tl1, tl2) + | l1, l2 -> f (l1 = l2) let zero = Some 0 @@ -258,12 +260,11 @@ and ac st m1 t1 m2 t2 = and ac_stacks st m1 m2 = (* L.warn "entering R.are_convertible_stacks"; *) - if List.length m1.s <> List.length m2.s then false else let map (c1, v1) (c2, v2) = let m1, m2 = reset m1 ~e:c1 zero, reset m2 ~e:c2 zero in ac st m1 v1 m2 v2 in - list_and map (m1.s, m2.s) + list_and C.start map (m1.s, m2.s) let rec ih_nfs st (m, t, r) = match t, r with