X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fhelena%2Fsrc%2Fbasic_rg%2FbrgOutput.ml;h=ac873ec6677dd24cdc27c8745edb996b6baea16f;hb=1be981691870cca039b1af1fb954491c2020d483;hp=78200e7e9be0e59122124ce88ee9f69e9cf2432c;hpb=edf9e34100f49d4aa5ba8f3ce53e34af7718d88e;p=helm.git diff --git a/helm/software/helena/src/basic_rg/brgOutput.ml b/helm/software/helena/src/basic_rg/brgOutput.ml index 78200e7e9..ac873ec66 100644 --- a/helm/software/helena/src/basic_rg/brgOutput.ml +++ b/helm/software/helena/src/basic_rg/brgOutput.ml @@ -52,13 +52,13 @@ let initial_counters = { } let rec count_term_binder f c e = function - | B.Abst (_, w) -> + | B.Abst (_, _, w) -> let c = {c with tabsts = succ c.tabsts; nodes = succ c.nodes} in count_term f c e w - | B.Abbr v -> + | B.Abbr v -> let c = {c with tabbrs = succ c.tabbrs; xnodes = succ c.xnodes} in count_term f c e v - | B.Void -> + | B.Void -> let c = {c with tvoids = succ c.tvoids; xnodes = succ c.xnodes} in f c @@ -135,52 +135,54 @@ let name err och a = in E.name err f a +let pp_reduced och x = + if x then KP.fprintf och "%s" "^" + let pp_level st och n = KP.fprintf och "%s" (N.to_string st n) let rec pp_term st e och = function - | B.Sort (_, h) -> + | B.Sort (_, h) -> let err _ = KP.fprintf och "*%u" h in let f s = KP.fprintf och "%s" s in H.string_of_sort err f h - | B.LRef (_, i) -> + | B.LRef (_, i) -> let err _ = KP.fprintf och "#%u" i in if !G.indexes then err () else let _, _, a, b = B.get e i in KP.fprintf och "%a" (name err) a - | B.GRef (_, s) -> + | B.GRef (_, s) -> KP.fprintf och "$%s" (U.string_of_uri s) - | B.Cast (_, u, t) -> + | B.Cast (_, u, t) -> KP.fprintf och "{%a}.%a" (pp_term st e) u (pp_term st e) t - | B.Appl (_, v, t) -> + | B.Appl (_, v, t) -> KP.fprintf och "(%a).%a" (pp_term st e) v (pp_term st e) t - | B.Bind (a, B.Abst (n, w), t) -> + | B.Bind (a, B.Abst (x, n, w), t) -> let a = R.alpha B.mem e a in - let ee = B.push e B.empty a (B.abst n w) in - KP.fprintf och "%a[%a:%a].%a" (pp_level st) n (name C.start) a (pp_term st e) w (pp_term st ee) t - | B.Bind (a, B.Abbr v, t) -> + let ee = B.push e B.empty a (B.abst x n w) in + KP.fprintf och "%a%a[%a:%a].%a" (pp_level st) n pp_reduced x (name C.start) a (pp_term st e) w (pp_term st ee) t + | B.Bind (a, B.Abbr v, t) -> let a = R.alpha B.mem e a in let ee = B.push e B.empty a (B.abbr v) in KP.fprintf och "[%a=%a].%a" (name C.start) a (pp_term st e) v (pp_term st ee) t - | B.Bind (a, B.Void, t) -> + | B.Bind (a, B.Void, t) -> let a = R.alpha B.mem e a in let ee = B.push e B.empty a B.Void in KP.fprintf och "[%a].%a" (name C.start) a (pp_term st ee) t let pp_lenv st och e = - let pp_entry f e c a b x = f x (* match b with - | B.Abst (a, w) -> - let a = R.alpha B.mem e a in - KP.fprintf och "%a : %a\n" (name C.start) a (pp_term st e) w; f a - | B.Abbr (a, v) -> - let a = R.alpha B.mem e a in - KP.fprintf och "%a = %a\n" (name C.start) a (pp_term st e) v; f a - | B.Void a -> - let a = R.alpha B.mem e a in - KP.fprintf och "%a\n" (name C.start) a; f a -*) in - let e = B.empty in - if e = B.empty then KP.fprintf och "%s\n" "not shown" else + let pp_entry f c a b x = + let a = R.alpha B.mem e a in + let x = B.push x c a b in + match b with + | B.Abst (_, _, w) -> + KP.fprintf och "[%a : %a] " (name C.start) a (pp_term st c) w; f x + | B.Abbr v -> + KP.fprintf och "[%a = %a] " (name C.start) a (pp_term st c) v; f x + | B.Void -> + KP.fprintf och "[%a]" (name C.start) a; f x + in + if e = B.empty then KP.fprintf och "%s" "empty" else B.fold_right ignore pp_entry e B.empty let specs = {