X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fsrc%2Fbasic_rg%2FbrgOutput.ml;h=ed024a68e8faeb50c6901ce118e9cd1a6e3ce0a4;hb=4025c3f5b36025380dcad84bb7a97045d08652f6;hp=c70bbfec757de4f0001b93914110b2d7d84ce865;hpb=bb2a0b22a2c38b59ca664b550f34e5e40e6f04c7;p=helm.git diff --git a/helm/software/lambda-delta/src/basic_rg/brgOutput.ml b/helm/software/lambda-delta/src/basic_rg/brgOutput.ml index c70bbfec7..ed024a68e 100644 --- a/helm/software/lambda-delta/src/basic_rg/brgOutput.ml +++ b/helm/software/lambda-delta/src/basic_rg/brgOutput.ml @@ -9,16 +9,18 @@ \ / This software is distributed as is, NO WARRANTY. V_______________________________________________________________ *) -module P = Printf -module F = Format -module C = Cps -module U = NUri -module L = Log -module O = Options -module Y = Entity -module X = XmlLibrary -module H = Hierarchy -module B = Brg +module P = Printf +module F = Format +module C = Cps +module U = NUri +module L = Log +module G = Options +module E = Entity +module H = Hierarchy +module N = Level +module XD = XmlCrg +module B = Brg +module BD = BrgCrg (* nodes count **************************************************************) @@ -47,13 +49,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 @@ -88,15 +90,15 @@ and count_term f c e = function count_term_binder f c e b let count_entity f c = function - | _, u, Y.Abst w -> + | _, u, E.Abst (_, w) -> let c = {c with eabsts = succ c.eabsts; nodes = succ c.nodes; uris = u :: c.uris } in count_term f c B.empty w - | _, _, Y.Abbr v -> + | _, _, E.Abbr v -> let c = {c with eabbrs = succ c.eabbrs; xnodes = succ c.xnodes} in count_term f c B.empty v - | _, _, Y.Void -> assert false + | _, _, E.Void -> assert false let print_counters f c = let terms = @@ -129,7 +131,7 @@ let rec does_not_occur f n r = function let f n1 r1 = if n1 = n && r1 = r then f false else does_not_occur f n r e in - Y.name C.err f a + E.name C.err f a let rename f e a = let rec aux f e n r = @@ -140,19 +142,22 @@ let rename f e a = does_not_occur f n r e in let f n0 r0 = - let f n r = if n = n0 && r = r0 then f a else f (Y.Name (n, r) :: a) in + let f n r = if n = n0 && r = r0 then f a else f (E.Name (n, r) :: a) in aux f e n0 r0 in - Y.name C.err f a + E.name C.err f a (* lenv/term pretty printing ************************************************) let name err frm a = let f n = function | true -> F.fprintf frm "%s" n - | false -> F.fprintf frm "^%s" n + | false -> F.fprintf frm "-%s" n in - Y.name err f a + E.name err f a + +let pp_level frm n = + if N.is_infinite n then () else F.fprintf frm "^%s" (N.to_string n) let rec pp_term e frm = function | B.Sort (_, h) -> @@ -161,7 +166,7 @@ let rec pp_term e frm = function H.string_of_sort err f h | B.LRef (_, i) -> let err _ = F.fprintf frm "@[#%u@]" i in - if !O.indexes then err () else + if !G.indexes then err () else let _, _, a, b = B.get e i in F.fprintf frm "@[%a@]" (name err) a | B.GRef (_, s) -> @@ -170,10 +175,10 @@ let rec pp_term e frm = function F.fprintf frm "@[{%a}.%a@]" (pp_term e) u (pp_term e) t | B.Appl (_, v, t) -> F.fprintf frm "@[(%a).%a@]" (pp_term e) v (pp_term e) t - | B.Bind (a, B.Abst w, t) -> + | B.Bind (a, B.Abst (n, w), t) -> let f a = - let ee = B.push e B.empty a (B.abst w) in - F.fprintf frm "@[[%a:%a].%a@]" (name C.err) a (pp_term e) w (pp_term ee) t + let ee = B.push e B.empty a (B.abst n w) in + F.fprintf frm "@[[%a:%a]%a.%a@]" (name C.err) a (pp_term e) w pp_level n (pp_term ee) t in rename f e a | B.Bind (a, B.Abbr v, t) -> @@ -209,50 +214,5 @@ let specs = { (* term xml printing ********************************************************) -let rec exp_term e t out tab = match t with - | B.Sort (a, l) -> - let a = - let err _ = a in - let f s = Y.Name (s, true) :: a in - H.string_of_sort err f l - in - let attrs = [X.position l; X.name a] in - X.tag X.sort attrs out tab - | B.LRef (a, i) -> - let a = - let err _ = a in - let f n r = Y.Name (n, r) :: a in - let _, _, a, b = B.get e i in - Y.name err f a - in - let attrs = [X.position i; X.name a] in - X.tag X.lref attrs out tab - | B.GRef (a, n) -> - let a = Y.Name (U.name_of_uri n, true) :: a in - let attrs = [X.uri n; X.name a] in - X.tag X.gref attrs out tab - | B.Cast (a, u, t) -> - let attrs = [] in - X.tag X.cast attrs ~contents:(exp_term e u) out tab; - exp_term e t out tab - | B.Appl (a, v, t) -> - let attrs = [] in - X.tag X.appl attrs ~contents:(exp_term e v) out tab; - exp_term e t out tab - | B.Bind (a, b, t) -> - let a = rename C.start e a in - exp_bind e a b out tab; - exp_term (B.push e B.empty a b) t out tab - -and exp_bind e a b out tab = match b with - | B.Abst w -> - let attrs = [X.name a; X.mark a] in - X.tag X.abst attrs ~contents:(exp_term e w) out tab - | B.Abbr v -> - let attrs = [X.name a; X.mark a] in - X.tag X.abbr attrs ~contents:(exp_term e v) out tab - | B.Void -> - let attrs = [X.name a; X.mark a] in - X.tag X.void attrs out tab - -let export_term = exp_term B.empty +let export_term = + BD.crg_of_brg XD.export_term